home *** CD-ROM | disk | FTP | other *** search
- ⓪ MODULE MM2Shell; (*$Z+,P+,V+,R-*)⓪ ⓪ (*⓪!*----------------------------------------------------------------------------⓪!* Copyright Februar 1987 Thomas Tempelmann & Manuel Chakravarty⓪!*----------------------------------------------------------------------------⓪!* Modul-Beschreibung : GEM-Shell für MOS / Megamax Modula-2⓪!*----------------------------------------------------------------------------⓪!* Version : 2.3g / Interne Version: V#1806⓪!*----------------------------------------------------------------------------⓪!* MCH: Manuel Chakravarty⓪!* TT: Thomas Tempelmann⓪!* MS: Michael Seyfried, Unterer Mauergarten 17, D-W6520 Worms 24⓪!* DS: Dirk Steins⓪!*----------------------------------------------------------------------------⓪!* Datum Version Autor Bemerkung (Arbeitsbericht)⓪!*----------------------------------------------------------------------------⓪!* 22.02.87 0.0 TT/OJO Erstellung unter C aus MyShell v. Oliver Joppich⓪!* 24.02.87 0.0 TT Erste lauffähige Version⓪!* 18.07.87 0.1 TT Individuelle Pathlisten für Compiler/Linker⓪!* 16.09.87 0.1 TT/MCH GEM-Moduln v. MCH; FileSelector nur bei GEM-Prgs.⓪!* 18.09.87 0.1 TT FileSelect rettet/restauriert Screen bei TOS-Prgs.⓪!* 15.10.87 0.2 MCH ShellShell⓪!* 07.11.87 0.2 MCH Anpassung an GEM V 0.10⓪!* 23.12.87 0.3 MCH 'load' und 'unload' impl.⓪!* 24.12.87 0.3 MCH Nachfolgendes von TT übernommen:⓪!* 05.10.87 TT Scan mit Modul 'GEMScan'⓪!* 07.10.87 TT Überflüssige Importe raus, Terminal.Write->Bconout⓪!* 16.10.87 TT SplitPath/Name: set_names, call,⓪!* 13.11.87 TT SetLinkName, GEMError nicht mehr importiert⓪!* 14.01.88 0.4 MCH TT's UserBrk eingebunden.⓪!* 06.02.88 1.0a TT Fertigstellung der ersten auslieferbaren Version:⓪!* diverse Kommentierung; Akt.File bleibt bei Tool-⓪!* Aufruf erhalten; Taste 'R' für Residente Module;⓪!* Klick auf Mem-Fenster toggled 'allMem';⓪!* viele kleine Optimierungen...⓪!* 19.02.88 1.0b TT Bei Prg-Start kann mit ALT-Taste der aktuelle Pfad⓪!* erhalten bleiben.⓪!* 01.03.88 1.0c TT 'ShellMsg.TextName' enthält "aktuelle Datei".⓪!* 14.04.88 1.0d TT SHELL.INF: mehrere inaktive LINK-Namen bestimmbar;⓪!* writeList nicht mehr rekursiv; readEntry: Compare⓪!* mit '..' optimiert.⓪!* 15.05.88 1.0e TT Prozedur 'fastCompare' neu. Desktop wird wiederher-⓪!* gestellt nach CALL-Anweisung in SHELL.INF⓪!* 28.05.88 1.0f TT Mit 'ESC' kann Laden von Modulen beim Starten unter-⓪!* drückt werden; MouseInput(TRUE) und ShowMouse⓪!* (TRUE) bei Rückkehr aus Programm in Shell; Bei⓪!* Code-Filter werden DEF-Module nicht ausgegeben.⓪!* 01.06.88 1.1 TT Linker-Optionen erweitert für optimierenden Linker;⓪!* LinkStackSize kann nun > 64KB sein.⓪!* 09.06.88 TT "Upper (LinkList[i].name)" aus "doLinkOptBox" ent-⓪!* fernt.⓪!* 25.06.88 1.1b TT "FastStrings" verwendet, einige Copy-Aufrufe durch⓪!* Delete ersetzt.⓪!* 19.07.88 1.2 MCH Auslagerung von 'EasyGEM0'⓪!* 20.07.88 1.2 MCH Alle Module die nur in 'ShellShell' gebraucht⓪!* werden, werden qualifiziert importiert.⓪!* Auslagerung von 'forceDeskRedraw' und⓪!* 'redrawDeskObj0' in 'EasyGEM0'⓪!* 27.07.88 1.3 MCH Benutzung von 'WindowLists'⓪!* 28.07.88 1.3 MCH " " "⓪!* 03.08.88 1.3b MCH 'dragSensitive' + Anfang der Selektierung⓪!* 04.08.88 1.3c MCH Selektierung mit Draggen funktioniert⓪!* 07.08.88 1.4 MCH Benutzung der Funktionen für komplexere Dialog-⓪!* boxen aus 'EasyGem0'⓪!* 17.08.88 1.5 MCH Neue Resource⓪!* 22.08.88 1.5 MCH Neue Resource + "Formatieren" begonnen⓪!* 24.08.88 1.5 MCH "Formatieren" fertig + 'makeFolder' + kopieren⓪!* + löschen⓪!* 25.08.88 1.5 MCH Schönheitsoperationen beim Kopieren und Löschen⓪!* 27.08.88 1.5 MCH Fileinformation⓪!* 28.08.88 1.5 MCH Editor-Parameter-Box⓪!* 29.08.88 1.6 MCH Parameter sichern und laden⓪!* 30.08.88 1.7 MCH Shelling⓪!* 31.08.88 2.0 MCH Vorversion für die Atari-Messe ('88)⓪!* 01.12.88 2.0 MCH Neues 'WindowLists' V0.07⓪!* 05.12.88 2.0 MCH Rausschmiß der 'selected'-Liste (WL V0.08)⓪!* 13.12.88 2.0 MCH Erweiterung auf 10 Arbeitsdateien⓪!* 26.12.88 2.0 MCH " " " "⓪!* 27.12.88 2.0 MCH " " " "⓪!* 19.01.89 2.0 MCH Kleine Änderungen⓪!* 26.01.89 2.0 MCH Kleine Änderungen⓪!* 01.02.89 2.0 MCH Schnellerer Fenster-Redraw⓪!* 11.02.89 2.0 MCH Batch-Erweiterung⓪!* 12.02.89 2.0 MCH Aligning der Icons macht nun round und nicht trunc⓪!* 14.02.89 2.0 MCH Temporäre Editor-Parameter-Dateien⓪!* 06.03.89 2.0 MCH Kein doppelter Backslash im Parameterpfad⓪!* 04.06.89 2.0 MCH Parameter-file-name wird aus der Argumentzeile⓪!* übernommen und beim Verlassen autom. Speicherung⓪!* des Parm.-files.⓪!* 07.06.89 2.0 MCH Drive.Icons werden richtig deselektiert + Kopieren⓪!* in einen Ordner im gleichen Fenster fkt. richtig.⓪!* 13.06.89 2.0 MCH⓪!* 19.06.89 2.0 MCH Änderungen von TT übernommen: pathSize auf 64 ge-⓪!* setzt.⓪!* 05.07.89 2.0 MCH Quick-Quit⓪!* 03.08.89 2.0 MCH Dir.-Einträge werden jetzt immer richtig sortiert⓪!* 05.08.89 2.0 MCH Der Default-Code-Pfad für neue Arbeitsdateien wird⓪!* jetzt mit Hilfe von 'Paths' ermittelt. Und eine neu⓪!* erzeugtes Arbeitsdatei-Objekt wird zum Aktuellen.⓪!* 06.08.89 2.0 MCH Arg.-Zeile wird gemerkt; Kein Copy auf selektierte⓪!* Einträge; Default-Code-Pfad erst beim Starten er-⓪!* mitteln; FileBox enthält bei Arbeitsdateien default-⓪!* mäßig den aktuellen Source-Namen⓪!* 07.08.89 2.0 MCH 'Loader.DefaultStackSize' in M2P sichern; LOAD⓪!* in M2B's verändert Default-Pfad nicht mehr;⓪!* Bei COMPILE in Batch-Dateien ist im Fehlerfall⓪!* das Edieren des Files möglich⓪!* 10.08.89 2.0 MCH 'HelpBox' und 'InfoBox' impl.; es kann wieder in⓪!* Ordner kopiert werden; Zielfenster wird nach⓪!* kopieren wieder neugezeichnet.⓪!* 11.08.89 2.0 MCH 'HelpBox' debugging; Shift-F1..10 funktioniert;⓪!* Es wird auch beim Ausführen von Source-Files nach⓪!* einem evtl. existierende Code gesucht.⓪!* 16.08.89 2.0e MCH/TT Änderungen von TT übernommen; Editor comp. Datei⓪!* bei exec. nur wenn nötig; Res.Mod. anklicken⓪!* => akt.Code setzen; 'LastCodeName/Size' impl.⓪!* 17.08.89 2.0f MCH Make eingebunden und ein paar bugs beseitigt;⓪!* beim Dir. öffnen gilt rechter Mausknopf wie⓪!* Shift; nur on line drives werden angezeigt;⓪!* 'WrapAlert' aus 'EasyGem0'⓪!* 19.08.89 2.0g MCH Pfadlisten werden richtig gelöscht und besetzt;⓪!* 'MakeFileName' in Umgebungs-Box; 'SearchFile'⓪!* wird auf 'LibFileName' angewendet.⓪!* 22.08.89 2.1 TT Änderungen von TT übernommen; alle Pfade validiert;⓪!* Source-Suffices aus ShellMsg importiert; MBT->M2B;⓪!* MSP->M2P; callEdit schaltet Ctrl-C temporär ab.⓪!* 23.08.89 TT args werden nur verwendet, wenn sie auch explizit⓪!* eingegeben wurden⓪!* 31.08.89 TT 'PrepareScan' setzt 'ScanOpts'⓪!* 03.09.89 TT Wenn Fehler beim Öffnen von Dir auf akt. Pfad⓪!* wird Wurzel geöffnet.⓪!* 06.09.89 2.1c TT KbdEvents wird während Shell-Dialog aktiviert⓪!* 11.09.89 2.1d TT KbdEvents wird anders aktiviert; neue Batch-Cmds;⓪!* call-Funktion verbessert -> nun wird immer der⓪!* Code-Pfad als akt. Pfad gesetzt, wenn nicht⓪!* 'noDirChange'.⓪!* 14.09.89 2.1e TT Editor-Parms: Toolbox-Flag raus, stattdessen⓪!* Flag f. Box-Anzeige nach Comp-Fehler; Editor⓪!* kann nun auch mit leerem Dateinamen gestartet⓪!* werden;⓪!* 20.09.89 2.1f TT Tool-Namen werden mit Endung angezeigt;⓪!* Tools und Systemprgs erhalten akt. Pfad, wenn⓪!* kein extra-Pfad angegeben ist;⓪!* Eventuelles 'HomeSymbol' in shellParm.batchPath,⓪!* editorParm.tempEditorName/tempShellName,⓪!* TemporaryPath u. DefLibName wird beim Lesen der⓪!* Parameter durch Shell-Homepath ersetzt;⓪!* Code-Suche in hdrun.getCodeDateTime korrigiert⓪!* 11.01.90 2.1g TT Inconsistent-Abfrage nach CallModule⓪!* 15.01.90 TT insertDirEntry: subDir-Aufruf durch Inline ersetzt;⓪!* Reihenfolgen in RECORDs, die auf Disk gesichert⓪!* werden verändert. ForceMediaChange-Aufruf⓪!* 17.01.90 TT CompilerParm nach ShellMsg übertragen⓪!* 28.02.90 TT Rsc um CompilerArgs erweitert, auch in M2P;⓪!* initWorkfile nach LoadParameter aufgerufen;⓪!* Real-Format in Env-Box angezeigt, Rsc: alle Über-⓪!* schriften mit Schattenbreite 2, Buttons verkleinert.⓪!* 14.03.90 2.1h MCH Verhalten beim Selektieren dem Desktop angeglichen;⓪!* Compile-Execute auf Plus-Taste; ALT-e/c/l rufen⓪!* Editor-, Compiler- bzw. Linker-Box auf; Beim Ende⓪!* eines Help-Textes wir der Abbruch-Button zum Default;⓪!* Keine Fehlermeldung mehr, falls in Parm.-Datei ein⓪!* leerer Batchpfad gesetzt ist; Ausführen setzt⓪!* aktuellen Code jetzt richtig⓪!* 16.03.90 TT Compiler, Editor, Make und Linker erhalten feste⓪!* StackSize beim Start⓪!* 01.05.90 2.1i TT 'HomePath' wird nicht mehr dauerhaft ersetzt, sondern⓪!* nur jeweils bei Benutzung, sodaß ein '*' im Pfad⓪!* dort erhalten bleibt; (Siehe "!TT")⓪!* Conditionals für KbdEvents-Aufrufe; HomePath wird⓪!* durch ShellRead ermittelt; ELSE teilw. bei CASE;⓪!* 'getFname' gelöscht, weil totaler Mist; In den⓪!* Umgebungsinfos kann bestimmt werden, ob nach Ende⓪!* eines nicht-GEM-Prgs auf einen Tastendruck gewartet⓪!* werden soll; Pfadname der M2P-Datei wird immer⓪!* korrekt eingesetzt.⓪!* 28.05.90 2.1j TT 'call' berücksichtigt 'HomePath', wenn er im Prg-⓪!* namen vorkommt.⓪!* 30.05.90 TT Batch-Dateien werden nun auf den Default-Pfaden⓪!* gesucht⓪!* 14.06.90 TT Im Init-Teil vom lokalen Modul 'ShellShell' können⓪!* nun zentral alle Dateiendungen definiert werden.⓪!* 16.06.90 2.1k TT Batch-Befehle DEFOUT, IMPOUT, MODOUT⓪!* 12.08.90 MCH ShellRead wieder eingesetzt⓪!* 05.10.90 2.1l MCH Änderungen übernommen⓪!* 07.10.90 2.1m MCH Noch mehr Änderungen übernommen⓪!* 24.10.90 2.1n TT $W- raus und 'alert' entspr. korrigiert; Anpassung⓪!* an neuen FormatDrive-Typ.⓪!* 20.11.90 2.1o TT Anpassung an neuen Loader ohne Stacksize-Parm;⓪!* M2P wird auf HomePath gesucht und weitere Korrekturen⓪!* in ShellShell-Body.⓪!* 01.12.90 2.1p MCH Benutzt neue 'EasyGEM0'-Routinen; das Starten von⓪!* Tools, die einen leeren Dateinamen besitzen wird⓪!* ignoriert; EXEC-Batch-Befehl funktioniert auch auf⓪!* Batch-Dateien; 'ShellGet'-Buffer ist jetzt auch für⓪!* den TT ausreichend; Icons werden autom. in den⓪!* sichtbaren Teil des Desktop-Koor.systems gebracht.⓪!* 11.12.90 2.2 TT FormError-Aufruf bei bestimmten Exitcodes ('call');⓪!* TermProcess (fInsufficientMemory), wenn InitSS⓪!* fehlschlägt; ShellName bei ShellWrite zurückgesetzt,⓪!* Flag 'DoShellWrite'; TermProcess (0), wenn keine RSC⓪!* 07.04.91 2.2b TT Höhe der Menüzeile korrigiert; ACCs werden vor/nach⓪!* Start von Programmen geschlossen; FileInformation⓪!* geht auch bei Ordnern; 'installDriveIcons' wird⓪!* nun erst nach Ausführen der Shell-Batch-Datei⓪!* durchgeführt, das hat den Vorteil, daß nun im⓪!* Batch temporär eine RAMDisk installiert werden kann;⓪!* Batch-Befehle "POSTAMBLE1/2" zum Starten von Prgs⓪!* vor Verlassen der Shell; Codename von Workfiles wird⓪!* nun immer korrekt behalten; beim Formatieren wird⓪!* nun das richtige Laufwerk ausgewählt.⓪!* 20.05.91 2.2d TT Bei manueller Arbeitsdateieingabe wird die Datei⓪!* auf den Source-Pfaden gesucht.⓪!* 20.10.91 2.3 TT Linker-Option-Box ermöglicht Symboldatei-Erzeugung.⓪!* MS Shell nun MultiGEM-fähig, dazu 'call' überarbeitet.⓪!* 22.05.93 2.3b TT Shell nun MultiTOS-fähig.⓪!* 15.07.93 2.3c DS Shell nun wirklich MultiTOS-fähig. Die Shell mit den⓪!* Änderungen von TT lief bei mir nicht unter MTOS.⓪!* Wichtigste Änderung: Unter MTOS wird kein ShelWrite⓪!* mehr vor einem Programmstart durchgeführt, da das⓪!* Programme direkt startet. Weiterhin wird der⓪!* GEMErrorHandler ausgeschaltet, da dieser anscheinend⓪!* unter MTOS fehlerhaft ist.⓪!* Alle Laufwerke werden angezeigt, auch die, die nicht⓪!* im DESKTOP.INF (bzw. NEWDESK.INF) drin sind.⓪!* Stacksize für Linker erhöht, da ich ein Programm⓪!* nicht mehr linken konnte.⓪!* Ganz sauber läuft die Shell übrigens noch immer nicht⓪!* unter MTOS, nach dem Linken hängt das System und auch⓪!* kann es ab und zu nach dem Compiler oder Make zu⓪!* Hängern kommen.⓪!* 12.12.93 2.3d TT Nochmalige Überarbeitung der V2.3c f. MultiTOS.⓪!* 14.01.94 2.3e TT Font kann nun in Shellparms eingestellt werden.⓪!* 29.03.94 2.3f TT Nun werden alle Laufwerke v. A bis Z berücksichtigt.⓪!*----------------------------------------------------------------------------⓪!*)⓪ ⓪ ⓪ (* Qualified imports for 'ShellShell' *)⓪ ⓪ IMPORT Clock, ModCtrl, TimeConvert,⓪'FileManagement,⓪ ⓪'GEMBase, AESMisc,⓪'GrafBase, GEMGlobals, GEMEnv,⓪'AESForms, AESObjects, AESWindows, AESResources, AESGraphics, AESMenus,⓪'AESEvents,⓪'VDIControls, VDIOutputs, VDIAttributes, VDIInquires,⓪'ObjHandler, EventHandler, TextWindows, EasyGEM0, EasyGEM1, WindowLists;⓪ ⓪ ⓪ FROM SYSTEM IMPORT LONGWORD, WORD, ADDRESS, BYTE,⓪7ASSEMBLER, ADR, LOAD, STORE;⓪ ⓪ IMPORT Mm2shellRsc; (* RSC-Datei *)⓪ ⓪ FROM RealCtrl IMPORT AnyRealFormat, UsedFormat;⓪ ⓪ FROM StrConv IMPORT CardToStr, IntToStr, StrToLCard, StrToCard,⓪7StrToInt, LHexToStr;⓪ ⓪ FROM Loader IMPORT LoaderResults, DefaultStackSize,⓪7LoadModule, CallModule, UnLoadModule;⓪ ⓪ FROM PathEnv IMPORT HomeReplaced, HomeSymbol, ReplaceHome, HomePath;⓪ FROM PathCtrl IMPORT PathList;⓪ FROM Paths IMPORT SearchFile, ListPos;⓪ ⓪ FROM Storage IMPORT ALLOCATE, DEALLOCATE, MemAvail, AllAvail, Inconsistent;⓪ ⓪ FROM Strings IMPORT PosLen, String, Relation, Compare, Space, Upper, Empty,⓪7EatSpaces, Append, StrEqual, Delete, Concat, Assign,⓪7Split, Insert, Length, Copy, Pos;⓪ ⓪ IMPORT Lists;⓪ ⓪ IMPORT SysUtil0;⓪ ⓪ FROM MOSConfig IMPORT StdDateMask;⓪ IMPORT MOSConfig;⓪ ⓪ IMPORT MOSCtrl, MOSGlobals;⓪ ⓪ FROM MOSGlobals IMPORT MemArea, BusFault, OddBusAddr, NoValidRETURN,⓪7OutOfStack, FileStr, PathStr, NameStr,⓪7fOK, fFileNotFound, fDriveNotReady, fWriteProtected,⓪7fPathNotFound, fInvalidDrive, fAccessDenied,⓪7fTooManyOpen, fInsufficientMemory, fEOF;⓪ ⓪ FROM ShellMsg IMPORT ScanMode, ScanAddr, TextName, ErrorMsg, DefPaths,⓪7ModPaths, ErrListFile, ImpPaths, SrcPaths, DefSfx,⓪7ImpSfx, ModSfx, CodeName, Active, LinkDesc,⓪7LLRange, ScanIndex, TextLine, TextCol,⓪7MakeFileName, TemporaryPath, MainOutputPath,⓪7DefLibName, DefOutPath, ImpOutPath, ModOutPath,⓪7ShellPath, ImpSrcSfx, ModSrcSfx, DefSrcSfx, CodeSize,⓪7StdPaths, CompilerArgs, CompilerParm, ScanOpts,⓪7LinkMode, LinkerParm, EditorParm;⓪ ⓪ FROM Directory IMPORT FileAttr, FileAttrSet, DirEntry, DirQueryProc,⓪7SetCurrentDir, GetCurrentDir, DefaultDrive,⓪7DirQuery, SetDefaultDrive, DrivesOnline,⓪7CreateDir, GetDefaultPath, SetFileAttr,⓪7ForceMediaChange, MakeFullPath, SetDefaultPath,⓪7FreeSpace;⓪ ⓪ FROM FileNames IMPORT StrToDrive, SplitPath, SplitName, DriveToStr,⓪7NameConc, ValidatePath, ConcatPath, ConcatName,⓪7FileName, FilePath;⓪ ⓪ FROM Files IMPORT File, Access, ReplaceMode,⓪7Create, Open, Close, State, ResetState, GetStateMsg,⓪7Remove, EOF, SetDateTime, GetDateTime;⓪ ⓪ FROM Binary IMPORT ReadBlock, ReadBytes, WriteBlock;⓪ ⓪ IMPORT Text;⓪ ⓪ FROM GEMScan IMPORT InputScan, CallingChain, ChainDepth;⓪ ⓪ FROM PrgCtrl IMPORT EnvlpCarrier,⓪7SetEnvelope, TermProcess;⓪4⓪ FROM SysTypes IMPORT ExcDesc, ExcSet, TRAP5;⓪ ⓪ FROM Excepts IMPORT InstallPreExc;⓪ ⓪ FROM SysBuffers IMPORT ExceptsStack;⓪ ⓪ FROM UserBreak IMPORT EnableBreak, DisableBreak;⓪ ⓪ FROM EasyGEM0 IMPORT WrapAlert;⓪ ⓪ FROM KbdEvents IMPORT DeInstallKbdEvents, InstallKbdEvents;⓪ ⓪ FROM TextWindows IMPORT BusyRead;⓪ ⓪ FROM EasyGEM0 IMPORT SetGetMode, ShowArrow, HideMouse, ShowMouse;⓪ ⓪ FROM AESForms IMPORT FormError, FormAlert;⓪ ⓪ ⓪ CONST DebugWdw = FALSE; (* Flag zur Fehlersuche (Debug-Fenster) *)⓪ ⓪((* Versionskennung der Shell.⓪)*)⓪(ShellRevision = ' 2.3g ';⓪ ⓪((*⓪)* Ist die folg. Konstante TRUE, wird das Modul "KbdEvents"⓪)* verwendet, das dafür sorgt, daß Tastendrücke, bei denen⓪)* Shift, Control oder Alternate gedrückt werden, immer richtig⓪)* erkannt werden.⓪)* Andernfalls kann es passieren, daß diese Umschalttasten⓪)* ignoriert werden, wenn die gewünschte Aktion erst nach⓪)* dem Tastendruck gestartet wird.⓪)* Siehe auch Hinweise im Definitions-Text des Moduls⓪)*)⓪(UseExtKeys = TRUE;⓪ ⓪((*⓪)* Ist die folg. Konstante TRUE, startet die Shell GEM-Programme⓪)* korrekt mit der AES-Funktion "ShellWrite", sofern TOS 1.4⓪)* oder höher verwendet wird. Dies kann aber zu Problemen führen,⓪)* beispielsweise, wenn die Shell von NEODESK gestartet wird,⓪)* weshalb sie dazu auf FALSE gesetzt werden kann.⓪)*)⓪(DoShellWrite = TRUE;⓪ ⓪((*⓪)* Stack-Größen für die Systemprogramme. Sie sollten vergrößert⓪)* werden, wenn bei einem der Programme ein "Stacküberlauf"⓪)* auftritt.⓪)*)⓪(CompilerStackSize = 16000;⓪(LinkerStackSize = 16000;⓪(EditorStackSize = 16000;⓪(MakeStackSize = 8000;⓪ ⓪((*⓪)* Maximale Anzahl von Suchpfaden, die in einer Batch-Datei⓪)* definiert werden können. Ist zu erhöhen, wenn beim Starten⓪)* der Shell oder eines Batches eine diesbezügliche Fehler-⓪)* meldung erscheint.⓪)*)⓪(MaxSearchPaths = 40;⓪ ⓪((*⓪)* Name der Datei in der alle zu compilierenden Module⓪)* vom Make abgelegt werden. Das Verzeichnis (Pfad), in dem⓪)* diese Datei erzeugt wird, ist der "temporäre Pfad", der⓪)* in der Shell-Parameter-Box anzugeben ist!⓪)*)⓪(MakeCompFileName = 'MAKE.M2C';⓪ ⓪ ⓪ TYPE actionType = (doEdit, doComp, doLink, doExec, doScan, doCpEx,⓪;doLoad, doUnLd, doCont, doBtch, doParm, doMake,⓪;doMkEx, doDftM);⓪(MySuf = (prg, app, tos, ttp, mos, mtp, mod, def, imp, m2p,⓪;m2b, m2m, m2d);⓪ ⓪(Str128 = ARRAY [0..127] OF CHAR;⓪ ⓪(ptrString = POINTER TO String;⓪ ⓪(PathEntry = POINTER TO PathStr;⓪ ⓪(Drive = ( defaultDrv, drvA, drvB, drvC, drvD, drvE, drvF, drvG,⓪2drvH, drvI, drvJ, drvK, drvL, drvM, drvN, drvO, drvP,⓪2drvQ, drvR, drvS, drvT, drvU, drvV, drvW, drvX, drvY, drvZ);⓪ ⓪(DriveSet = SET OF [drvA..drvZ];⓪ ⓪ ⓪ VAR lastFn, currFn,⓪(workFName, workCName : FileStr;⓪(args : ARRAY[0..127] OF CHAR;⓪ ⓪(suf: ARRAY MySuf OF ARRAY [0..2] OF CHAR;⓪ ⓪ ⓪0(* Konfigurationsvariablen *)⓪0(* ======================= *)⓪ ⓪(shellParm : RECORD⓪<breakActive : BOOLEAN;⓪<confirmDelete : BOOLEAN;⓪<confirmCopy : BOOLEAN;⓪<defaultOpenCurrDir: BOOLEAN;⓪<useAllMemForCopy : BOOLEAN;⓪<batchPath : PathStr;⓪<parameterPath : PathStr;⓪<sectors : CARDINAL;⓪<tracks : CARDINAL;⓪<sides : CARDINAL;⓪<makeName : String;⓪<waitOnReturn : BOOLEAN;⓪:END;⓪ ⓪(fontSetting: RECORD⓪7name: ARRAY [0..31] OF CHAR;⓪7size: CARDINAL⓪5END;⓪ ⓪(noDirChange: BOOLEAN;⓪ ⓪ PROCEDURE conc ( REF s1,s2: ARRAY OF CHAR ): Str128;⓪"VAR s: Str128;⓪&voidO: BOOLEAN;⓪"BEGIN⓪$Concat (s1,s2,s, voidO);⓪$RETURN s⓪"END conc;⓪ ⓪ ⓪ FORWARD action (what:actionType;wrkFile,tool:BOOLEAN);⓪ ⓪ FORWARD FileAlert (errNo: INTEGER);⓪ FORWARD SaveParameter;⓪ FORWARD LoadParameter (REF name: ARRAY OF CHAR);⓪ FORWARD ExecuteBatch (name: ARRAY OF CHAR; load: BOOLEAN);⓪ ⓪ ⓪ MODULE ShellShell; (* Verwaltet alle GEM-Aktionen der Modula Shell *)⓪ ⓪ ⓪ IMPORT Text, SysUtil0,⓪ ⓪'DebugWdw, (* debug flag *)⓪'⓪0(* resource indicies *)⓪*⓪'Menu, Mibox, Mshell, Mdatei, Mparms, Minfo,⓪'Mtools, Dinfo, Mdinfo, Mdfolder, Mdformat, Mdclose,⓪'Mdclosew, Mdnwork, Mdkwork, Mdquit, Mpshell, Mpeditor,⓪'Mpcomp, Mplink, Mpsave, Mienv, Mihelp, Midocu, Tibox,⓪'Mtool1, Mtool2, Mtool3, Mtool4, Mtool5, Mtool6,⓪'Mtool7, Mtool8, Mtool9, Mtool10, Desktop, Currfile,⓪'Cfhead, Cfname, Cftext, Cfcode, Driveb, Drivec,⓪'Drived, Drivee, Drivef, Driveg, Driveh, Drivei,⓪'Drivej, Drivek, Drivel, Drivem, Driven, Driveo,⓪'Drivep, Trash, Scan, Edit, Compile, Execute,⓪'Link, Resident, Work0, Work1, Work2, Work6,⓪'Work7, Work8, Work3, Drivea, Work9, Work4,⓪'Work5, Finfobox, Finame, Fiok, Fiquit, Fisize,⓪'Firw, Fiprot, Optbox, Oquit, Ook, Oquite,⓪'Opmark, Opwidth, Oppath, Ooutput, Oargs, Oerror, Olibrary,⓪'Oname, Shellbox, Version, Scanbox, Sok, Squit,⓪'Saddr, Filebox, Cfok, Cfcurr, Cfedit, Cfbok, Stponrtn,⓪'Cfwork, Snamebox, Snedit, Snok, Snwork, Snquit,⓪'Argbox, Aedit, Aok, Loptbox, Locheck1, Locheck2,⓪'Locheck3, Locheck4, Locheck5, Locheck6, Locheck7, Locheck8,⓪'Lofname1, Lofname2, Lofname3, Lofname4, Lofname5, Lofname6,⓪'Lofname7, Lofname8, Lochecks, Lostack, Lofull, Lomiddle,⓪'Lonoopt, Lonamopt, Lomaxmod, Look, Loquit, Loname,⓪'Lofastld, Lofastco, Lofastme, Losymfil, Loadbox,⓪'Lfname, Fldrbox, Fdfolder, Fdname, Fdok, Fdconf,⓪'Confibox, Codelete, Conumber, Cook, Coquit, Cocopy,⓪'Cowork, Formabox, Fosingle, Fodouble, Fo80, Fo81,⓪'Foremain, Fo9, Fo10, Foa, Fob, Foquit,⓪'Foname, Sparmbox, Sproot, Spcurr, Spcopy, Spbreak,⓪'Spdelete, Spallmem, Spbaname, Sppaname, Spok, Spquit,⓪'Spscpath, Spfontn, Spfonts, Spmake, Msgbar, Mbmsg, Eparmbox,⓪'Epname, Epsearch, Epstoper, Epshtemp, Epshname, Epedtemp,⓪'Epedname, Eparg, Eparname, Eparpos, Eparerro, Epok,⓪'Epquit, Helpbox, Hpnext, Hpprev, Hpquit, Hpmsgs,⓪'Hpmsg1, Hpmsg2, Hpmsg3, Hpmsg4, Hpmsg5, Hpmsg6,⓪'Hpmsg7, Hpmsg8, Hpmsg9, Hpmsg10, Hpmsg11, Hpmsg12,⓪'Hpmsg13, Hpmsg14, Infobox, Incode, Ihome, Inlength, Inpath, Realform,⓪'Instack, Inmkfile, Inblock, Inall, Inok, Inquit, Nowdwalt,⓪'Pathalt, Windalt, Optalt, Memalt, Icon2alt, Spacemsg,⓪'Editstr, Editbstr, Npathstr, Debugalt, Noldstr, Okstr,⓪'Nouldstr, Noexestr, Retstr, Contmalt,⓪'Edstr, Workstr, Compstr, Linkstr, Infstr, Contstr,⓪'Formaalt, Parmsalt, Foerralt, Noparalt, Nowrkalt,⓪'Exitalt, Loadalt, Alrtfont, Nohlpalt, Makestr,⓪ ⓪%⓪0(* from the library *)⓪ ⓪'ADDRESS, BYTE, WORD,⓪'ASSEMBLER, ADR, LOAD, STORE,⓪'⓪'(* Storage *)⓪'ALLOCATE, DEALLOCATE, MemAvail, AllAvail,⓪ ⓪'(* RealCtrl *)⓪'AnyRealFormat, UsedFormat,⓪'⓪'(* Strings *)⓪'String, Relation,⓪'Concat, Insert, Split, Assign, Length, Compare, Copy, Space,⓪'Upper, Empty, EatSpaces, Append, StrEqual, PosLen, Delete, Pos,⓪'⓪'MOSConfig,⓪'DefSrcSfx, ImpSrcSfx, ModSrcSfx, StdDateMask,⓪'⓪'(* StrConv *)⓪'CardToStr, IntToStr, StrToCard, StrToLCard, LHexToStr,⓪ ⓪'(* Directory *)⓪'FileAttr, FileAttrSet, DirEntry, DirQueryProc, Drive, DriveSet,⓪'DirQuery, SplitPath, SplitName, SetFileAttr, StrToDrive, FreeSpace,⓪'DriveToStr, DefaultDrive, CreateDir, GetCurrentDir, SetDefaultDrive,⓪'SetCurrentDir, FileStr, PathStr, NameStr, DrivesOnline, ValidatePath,⓪'ForceMediaChange, MakeFullPath, ConcatPath, ConcatName, SetDefaultPath,⓪'FileName, GetDefaultPath, FilePath,⓪'⓪'(* ShellMsg *)⓪'ScanMode, TextName, CodeName, DefSfx, ImpSfx, ModSfx, ScanAddr,⓪'ErrListFile, LinkDesc, TemporaryPath, LLRange,⓪'ShellPath, MakeFileName, DefLibName, MainOutputPath, ScanOpts,⓪'SrcPaths, DefPaths, EditorParm, CompilerParm, LinkerParm, LinkMode,⓪'⓪'(* Loader *)⓪'DefaultStackSize,⓪'⓪'(* MOSGlobals *)⓪'MOSGlobals,⓪'fOK, fEOF, fFileNotFound,⓪'MemArea,⓪'⓪'(* Files *)⓪'File, Access,⓪'State, Open, Close, ResetState,⓪'⓪'(* Binary *)⓪'ReadBlock, WriteBlock,⓪'⓪'(* GEMScan *)⓪'ChainDepth,⓪'⓪'(* Exceptions *)⓪'TRAP5, ExcSet, ExcDesc,⓪'ExceptsStack, InstallPreExc,⓪'⓪'(* Paths *)⓪'ListPos,⓪'ReplaceHome, SearchFile,⓪'HomePath, HomeSymbol,⓪'⓪'(* PrgCtrl *)⓪'TermProcess,⓪'⓪'(* from the outer module *)⓪'CompilerArgs,⓪'actionType, Str128,⓪'lastFn, currFn, MySuf, ShellRevision,⓪'action, suf, args, noDirChange, fontSetting, shellParm, conc,⓪'SaveParameter, LoadParameter, FileAlert, ExecuteBatch;⓪ ⓪ (* MOS *)⓪ ⓪ FROM MOSCtrl IMPORT RealMode;⓪ ⓪ FROM Clock IMPORT Date, Time;⓪ ⓪ FROM ModCtrl IMPORT ModQuery;⓪ ⓪ FROM TimeConvert IMPORT TimeToText, DateToText;⓪ ⓪ FROM Lists IMPORT List, LDir, InitList,⓪?CreateList, DeleteList, ResetList, AppendEntry,⓪?InsertEntry, NextEntry, PrevEntry, RemoveEntry,⓪?CurrentEntry, ListEmpty, ScanEntries,⓪?NoOfEntries, EndOfList;⓪ ⓪ FROM FileManagement IMPORT FormatDrive, FormatResult,⓪?FormatDisk, CountFilesAndDirs, CopyFiles,⓪?DeleteFiles, FileInformation;⓪ ⓪ (* Graphics *)⓪ ⓪ FROM GrafBase IMPORT black, Pnt, Rect, PtrBitPattern, WritingMode,⓪7Point, Rectangle, TransRect, MinPoint, ClipRect,⓪7FrameRects;⓪5⓪ (* General GEM *)⓪ ⓪ FROM GEMGlobals IMPORT Root, MaxDepth, NoObject, MaxStr,⓪7PtrObjTree, GemChar, MouseButton, MButtonSet,⓪7SpecialKeySet, ObjState, OStateSet, ObjFlag,⓪7OFlagSet, ObjType, FillType, SpecialKey, PtrMaxStr,⓪7LineType;⓪ ⓪ FROM GEMEnv IMPORT RC, GemHandle, DeviceHandle, DevParm, PtrDevParm,⓪7InitGem, ExitGem, GemActive, CurrGemHandle,⓪7SetCurrGemHandle, GemError, MouseInput, DeviceParameter;⓪ ⓪ (* VDI *)⓪ ⓪ FROM VDIControls IMPORT SetClipping, DisableClipping;⓪ ⓪ FROM VDIOutputs IMPORT PolyLine;⓪ ⓪ FROM VDIInquires IMPORT GetFaceName, GetFaceInfo;⓪ ⓪ FROM VDIAttributes IMPORT SetLineType, SetLineColor, SetWritingMode,⓪?DefUserLine;⓪ ⓪ (* AES *)⓪ ⓪ FROM AESForms IMPORT FormDialMode,⓪?FormDial, FormDo, FormAlert;⓪ ⓪ FROM AESObjects IMPORT FindObject, DrawObject;⓪ ⓪ FROM AESWindows IMPORT DeskHandle,⓪?MouseControl, SetNewDesk, UpdateWindow;⓪ ⓪ FROM AESResources IMPORT ResourcePart,⓪?LoadResource, FreeResource, ResourceAddr;⓪ ⓪ FROM AESGraphics IMPORT MouseForm,⓪?DragBox, MouseKeyState, GrafMouse, RubberBox;⓪ ⓪ FROM AESMenus IMPORT MenuBar, NormalTitle, EnableItem, MenuText,⓪?CheckItem;⓪ ⓪ FROM AESEvents IMPORT menuSelected, Event, RectEnterMode;⓪ ⓪ FROM AESMisc IMPORT ShellGet, ShellRead;⓪ ⓪ IMPORT GEMBase;⓪ ⓪ (* Beyond GEM *)⓪ ⓪ FROM ObjHandler IMPORT SetPtrChoice,⓪?SetCurrObjTree, CurrObjTree,⓪?ObjectState, SetObjSpace, ObjectSpace,⓪?ObjectFlags, BorderThickness, AssignTextStrings,⓪?GetTextStrings, ObjTreeError, LinkTextString,⓪?SetObjFlags, CreateSpecification, ObjectType,⓪?SetObjType, SetIconForm, GetIconForm,⓪?SetIconLook, GetIconLook, GetComplexColor,⓪?SetComplexColor, GetIconColor, SetIconColor,⓪?SetObjState, GetObjRelatives, RightSister;⓪ ⓪ FROM EventHandler IMPORT EventProc, WatchDogCarrier,⓪?HandleEvents, ShareTime, DeInstallWatchDog,⓪?InstallWatchDog, FlushEvents;⓪ ⓪ IMPORT TextWindows;⓪ (*⓪ FROM TextWindows IMPORT Window, ForceMode, WindowQuality, WQualitySet,⓪?NoWind,⓪?Write, WriteString, WriteLn, GotoXY,⓪?Read, WritePg, BusyRead;⓪!*)⓪ ⓪ FROM EasyGEM0 IMPORT SetGetMode, ObjEnumRef,⓪?ShowArrow, HideMouse, ShowMouse,⓪?ObjectSpaceWithAttrs, AbsObjectSpace,⓪?GetTextString, SetTextString, SetObjStateElem,⓪?ToggleObjState, ObjectStateElem, SetObjFlag,⓪?PrepareBox, ReleaseBox, DoSimpleBox,⓪?ForceDeskRedraw, DrawObjInWdw, DeskSize,⓪?DeselectButton, ToggleCheckBox, ToggleCheckPlus,⓪?SetGetBoxLCard, SetGetBoxStr, SetGetBoxEnum,⓪?SetGetBoxState, SetGetBoxCard, CharSize,⓪?ToggleSelectBox, ObjectFlag, TreeAddress,⓪?TextStringAddress;⓪ ⓪ FROM WindowLists IMPORT WindowList, NoWindowList, DetectModeWL,⓪?EntryToStrProcWL, CloseProcWL,⓪?SelectEntryProcWL, AttributeWL,⓪?AttributesWL, CenterWindowWL, MaxWindowWL,⓪?QueryDirectionWL, ErrorStateWL, CreateWL,⓪?DeleteWL, SetListWL, GetListWL, ShowWindowWL,⓪?HideWindowWL, DetectWindowWL, IsTopWindowWL,⓪?SelectAreaWL, WindowSizeWL, EntryAttributesWL,⓪?SetEntryAttributesWL, QueryListWL, GetEntryBoxWL,⓪?StateWL, ResetStateWL, ViewLineWL,⓪?PutWindowOnTopWL, SetWindowSizeWL;⓪ ⓪ ⓪ EXPORT TellMode, MaxTool, ToolField, NoPathsStr, EditBatStr,⓪'NoLoadStr, OkStr, NoUnloadStr, NoExecStr, RetStr, EdStr, MakeStr,⓪'WorkStr, CompStr, LinkStr, InfStr, ContMakeAlt, noParmAlt, ContStr,⓪'InitSS, ExitSS, ShowSS, HideSS, TalkWithUser, RequestArg, ScanBox,⓪'TellLoading, ClearDeskAndShowMsg, ShowBee, SetGetWindows,⓪'SetGetDeskPositions, WorkField, IsSourceName,⓪'memErrorAlt, ShellName, LastCodeName, LastCodeSize, EditStr,⓪'maxWorkFiles, appl_init, appl_exit, multiGEM, multiTOS,⓪'(*$ ? DebugWdw: dWriteLn, dWrite, dWait, *)⓪'SetWindowSizes, SetFonts, AESUpdateWindow, InitWorkfile, IsMBTFile;⓪ ⓪ CONST minNecessaryMem = 50L * 1024L; (* min. 50k Speicher *)⓪ ⓪(screenColumns = 80; (* screen width in chars *)⓪ ⓪(MaxTool = 10;⓪(maxWorkFiles = 10;⓪ ⓪(resourceFile = 'MM2SHELL.RSC';⓪(batchFile = 'MM2SHELL.M2B';⓪(parameterFile = 'MM2SHELL.M2P';⓪(helpFile = 'MM2SHELL.HLP';⓪(noDrvIcons = 16; (* Anzahl der Drive-Icons *)⓪(minDrv = drvA;⓪(maxDrv = drvP;⓪(fileBoxLength = 41; (* Länge des file box edit strings *)⓪(maxDftPathInfo = 43; (* 'infoBox.Inpath' length *)⓪(maxCodeFileInfo = 43; (* 'infoBox.Incode' length *)⓪(maxDefLibName = 33; (* 'infoBox.Inmkfile' length *)⓪ ⓪(maxWfChars = 24; (* Maximale Anzahl der Zeichen, die im Ar-⓪@* beitsdatei-Icon des Desks angezeigt werden⓪@*)⓪(msgStrLen = 70;⓪(⓪(noRscAlt1 = '[3][Das Resource File kann|nicht geladen werden!]';⓪(noRscAlt2 = '[ Bye Bye... ]';⓪(⓪(noGemAlt1 = '[3][Anmeldung beim GEM|ist nicht gelungen!]';⓪(noGemAlt2 = '[ Pech ?! ]';⓪(⓪(memErrorAlt = 'Fehler in Speicherverwaltung|Neustart empfohlen!';⓪(⓪(stdProtWidth = 80; (* Standardbreite des Compilerprotokolls *)⓪(⓪(undoKey = BYTE (97);⓪(⓪(⓪ TYPE ptrRectangle = POINTER TO Rectangle;⓪(ptrList = POINTER TO List;⓪(ptrString = POINTER TO String;⓪(⓪(driveDskr = RECORD⓪<available : BOOLEAN;⓪<treeIndex : CARDINAL;⓪:END;⓪9⓪:⓪0(* definitions for the shell windows *)⓪0(* --------------------------------- *)⓪:⓪ CONST dirLeftBorder = 3; (* Formatierungskonstanten für *)⓪(dirNameLen = 9; (* die Dir.-Fensterausgabe *)⓪(dirExtLen = 3;⓪(dirGap = 3;⓪(dirSizeLen = 7;⓪(dirRightBorder = 1;⓪(dirTimeLen = 5;⓪(dirWidthNoDate = dirLeftBorder + dirNameLen + dirExtLen + dirGap +⓪:dirSizeLen + dirGap + dirTimeLen + dirGap +⓪:dirRightBorder;⓪(dirVisibleWidth = dirLeftBorder + dirNameLen + dirExtLen + dirGap;⓪ VAR dirDateLen,⓪(dirWdwWidth : CARDINAL;⓪ ⓪ CONST modWdwTitle = ' Geladene Module ';⓪(modWdwTitleAll = ' Residente Module ';⓪(⓪(maxModNameLen = 20; (* Max. Zahl der Zeichen eines Modul-⓪D* namens die im Fenster sichtbar sind.⓪D*)⓪(lCardLog = 10; (* Max. Dezimalstellen eines LONGCARD's *)⓪(modGap = 1;⓪(modModFlag = ' Modul';⓪(modModLen = 6; (* Anzahl der Zeichen in 'modModFlag' *)⓪(modLoadFlag = 'Geladen';⓪(modLoadLen = 7; (* = Length (modLoadFlag) *)⓪(modRsdFlag = 'Resident';⓪(modRsdLen = 8; (* = Length (modRsdFlag) *)⓪(⓪(modDataLen = modGap + lCardLog +modGap + lCardLog + modGap +⓪:modModLen + modGap + modRsdLen;⓪(modDataLenAll = modDataLen + modGap + modLoadLen;⓪:⓪(modWdwWidth = maxModNameLen + modDataLen;⓪(modWdwWidthAll = maxModNameLen + modDataLenAll;⓪:⓪ CONST maxWdw = 5; (* Max. Fensterzahl *)⓪(firstWdwColumn = 40;⓪(⓪ TYPE modEntry = RECORD (* entry of the module list *)⓪<name : ARRAY[0..79] OF CHAR;⓪<lenOfCode : LONGCARD;⓪<lenOfVar : LONGCARD;⓪<isModul : BOOLEAN;⓪<wasLoaded : BOOLEAN;⓪<isResident : BOOLEAN;⓪:END;⓪(ptrModEntry = POINTER TO modEntry;⓪(⓪(ptrDirEntry = POINTER TO RECORD⓪<entry: DirEntry;⓪<str : String;⓪:END;⓪:⓪(wdwSlotIdx = [1..maxWdw];⓪(wdwKind = (dirWdw, modWdw);⓪(wdwSlot = RECORD⓪<wl : WindowList; (* handle *)⓪<used,⓪<isTop : BOOLEAN;⓪<noSelected: CARDINAL;⓪<tmpSpace : Rectangle;⓪<CASE kind: wdwKind OF⓪>dirWdw : path : Str128|⓪>modWdw : all : BOOLEAN| (* all modules *)⓪<END;⓪:END;⓪(ptrWdwSlot = POINTER TO wdwSlot;⓪:⓪ VAR wdws : ARRAY wdwSlotIdx OF ptrWdwSlot;⓪ ⓪ ⓪ CONST noCurrentWorkfile = -1; (* more info at 'WorkField' *)⓪(⓪ VAR⓪0(* globale handles *)⓪ ⓪(dev : DeviceHandle;⓪(gemHdl : GemHandle;⓪(multiGEM : BOOLEAN;⓪(multiTOS : BOOLEAN;⓪(menu, desk, scanBox,⓪(shellBox, optBox,⓪(fileInfoBox, fileBox,⓪(shellParmBox, editorParmBox,⓪(sNameBox, argBox,⓪(linkBox, loadBox,⓪(fNameBox, formatBox,⓪(msgBar, confirmBox,⓪(helpBox, infoBox : PtrObjTree;⓪(⓪(aesPB : GEMBase.AESPB;⓪(vdiPB : GEMBase.VDIPB;⓪(⓪(noWindAlt, pathToLongAlt,⓪(windErrAlt, formatAlt,⓪(cOptToLongAlt, wrgIcon2Alt,⓪(memFullAlt, drvSpaceMsg,⓪(debugAlt, formatErrAlt,⓪(NoLoadStr, OkStr, NoPathsStr,⓪(NoUnloadStr, NoExecStr,⓪(RetStr, EdStr, WorkStr,⓪(CompStr, LinkStr, InfStr,⓪(ContMakeAlt, ContStr, EditStr, EditBatStr,⓪(parmSaveAlt, noParmAlt,⓪(noNewWorkAlt, loadFailedAlt,⓪(exitShellAlt, noHelpAlt,⓪(fontErrAlt,⓪(MakeStr : PtrMaxStr;⓪(⓪(linkBoxIdx : ARRAY[1..8] OF RECORD⓪8check,⓪8path : CARDINAL;⓪6END;⓪(⓪(drives : ARRAY[minDrv..maxDrv] OF driveDskr;⓪(⓪(ToolField : ARRAY[1..MaxTool] OF RECORD⓪8index : CARDINAL; (* Menu-Obj. *)⓪8⓪8CASE used :BOOLEAN OF⓪:TRUE : name : FileStr;⓪8END;⓪6END;⓪ ⓪((* Contains all work files.⓪)*)⓪(WorkField : RECORD⓪8noUsed : CARDINAL;⓪8current: INTEGER;⓪8elems : ARRAY[0..maxWorkFiles - 1] OF RECORD⓪CnameIdx : CARDINAL;⓪CidentIdx : CARDINAL;⓪CcarrierIdx : CARDINAL;⓪Cused : BOOLEAN;⓪CcodeName : FileStr;⓪CsourceName : FileStr;⓪AEND;⓪6END;⓪(⓪(msgStr : String;⓪(⓪(⓪0(* Variablen, die die aktuellen Shellparameter speichern *)⓪ ⓪(selectedDrive : Drive; (* '= defaultDrv' <=> none sel. *)⓪(quitStatus : (noQuit, quit, quickQuit);⓪(LastCodeName : FileStr;⓪(LastCodeSize : LONGCARD;⓪(⓪0(* Globale Infovariablen *)⓪(⓪(deskSize,⓪(alignedDeskSize : Rectangle;⓪(charWidth, charHeight : CARDINAL;⓪(⓪(tellSpace : Rectangle; (* Darf nur von 'TellLoading'⓪Q* benutzt werden.⓪Q*)⓪ ⓪(lastArgs: ARRAY [0..127] OF CHAR;⓪ ⓪(ShellName: FileStr;⓪ ⓪0(* Globale Kurzzeitvariablen *)⓪(⓪(ok : BOOLEAN; (* Siehe auch 'notOKAlert' *)⓪(but : CARDINAL;⓪(⓪0(* global dummies *)⓪(⓪(voidC : CARDINAL;⓪(voidO : BOOLEAN;⓪(voidCh : CHAR;⓪(voidI : INTEGER;⓪(void128 : ARRAY [0..127] OF CHAR;⓪(voidSlot : wdwSlotIdx;⓪(voidADR : ADDRESS;⓪(voidFrame: Rectangle;⓪ ⓪ (*$ ? DebugWdw:⓪(⓪(dWdw : Window;⓪(⓪ PROCEDURE dWriteLn (str: ARRAY OF CHAR);⓪ ⓪ BEGIN⓪"WriteString (dWdw, str); WriteLn (dWdw);⓪ END dWriteLn;⓪ ⓪ PROCEDURE dWrite (str: ARRAY OF CHAR);⓪ ⓪ BEGIN⓪"WriteString (dWdw, str);⓪ END dWrite;⓪ ⓪ PROCEDURE dWait;⓪ VAR ch: CHAR;⓪ BEGIN⓪"Read (dWdw,ch)⓪ END dWait;⓪ ⓪ PROCEDURE dWriteCard (c, spc: CARDINAL);⓪ ⓪ BEGIN⓪"dWrite (CardToStr (c, spc));⓪ END dWriteCard;⓪ ⓪ PROCEDURE dWriteInt (c: INTEGER; spc: CARDINAL);⓪ ⓪ BEGIN⓪"dWrite (IntToStr (c, spc));⓪ END dWriteInt;⓪ ⓪ ⓪ *)⓪ ⓪ ⓪8(* Diverse Hilfsroutinen *)⓪8(* ===================== *)⓪ ⓪((* mouse *)⓪(⓪ PROCEDURE mouseImage;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪*DC.W $0, $0, $1, $0, $1⓪*DC.W $07F0,$07F0,$07F0,$07F0,$0FF8,$1FFC,$3FFE,$3FFF⓪*DC.W $3FFF,$3FFF,$1FFF,$0FFF,$0FFF,$07FF,$03FF,$03FE⓪*DC.W $0000,$03E0,$03E0,$02A0,$07F0,$0E38,$1F7C,$1FFD⓪*DC.W $1FFC,$1FFD,$0FF8,$07F2,$07FD,$03E0,$01CA,$01E8⓪$END;⓪"END mouseImage;⓪"(*$L=*)⓪ ⓪ PROCEDURE appl_init;⓪"BEGIN⓪$WITH aesPB DO⓪&WITH pcontrl^ DO⓪(opcode:= 10;⓪(sintin:= 0;⓪(sintout:= 1;⓪(sadrin:= 0;⓪(sadrout:= 0;⓪&END;⓪$END;⓪$GEMBase.CallAES( ADR( aesPB));⓪"END appl_init;⓪ ⓪ PROCEDURE appl_exit;⓪"BEGIN⓪$WITH aesPB DO⓪&WITH pcontrl^ DO⓪(opcode:= 19;⓪(sintin:= 0;⓪(sintout:= 1;⓪(sadrin:= 0;⓪(sadrout:= 0;⓪&END;⓪$END;⓪$GEMBase.CallAES( ADR( aesPB));⓪"END appl_exit;⓪ ⓪ PROCEDURE ShowBee;⓪"BEGIN⓪$IF multiTOS THEN⓪&GrafMouse (bee, NIL);⓪$ELSE⓪&GrafMouse (userCursor, ADDRESS (mouseImage))⓪$END;⓪"END ShowBee;⓪ ⓪ PROCEDURE AESUpdateWindow (b: BOOLEAN);⓪!BEGIN⓪#UpdateWindow (b)⓪!END AESUpdateWindow;⓪ ⓪ PROCEDURE SetFonts;⓪"(* aktualisiert Fonts bei TextWindows und WindowLists *)⓪"VAR c: CARDINAL; i: INTEGER; ok: BOOLEAN; dummyList: List; slot: wdwSlotIdx;⓪"BEGIN⓪$WITH fontSetting DO⓪&IF Empty (name) THEN GetFaceName (dev, 1, name); END;⓪&IF size = 0 THEN size:= 10; END;⓪&(* zuerst den Default-Font bei TextWindows setzen *)⓪&TextWindows.ReSpecify (TextWindows.Window(NIL), 0, size, name, ok);⓪&IF ~ok THEN⓪((* Font kann nicht eingestellt werden. Vermutlich ist Name falsch *)⓪(FormAlert (1, fontErrAlt^, c);⓪&ELSE⓪((* Default-Font nun bei WindowLists setzen *)⓪(SetListWL (NoWindowList, dummyList, EntryToStrProcWL (NIL),⓪,CloseProcWL (NIL), SelectEntryProcWL (NIL), NIL, size, name);⓪((* zuletzt Font bei offenen Fenstern setzen *)⓪(FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO⓪*WITH wdws[slot]^ DO⓪,SetListWL (wl, dummyList, EntryToStrProcWL (NIL), CloseProcWL (NIL),⓪0SelectEntryProcWL (NIL), NIL, size, name);⓪*END;⓪(END;⓪&END;⓪$END;⓪"END SetFonts;⓪ ⓪ PROCEDURE SetWindowSizes;⓪"VAR slot: wdwSlotIdx;⓪"BEGIN⓪$FOR slot:= MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO⓪&SetWindowSizeWL (wdws[slot]^.wl, wdws[slot]^.tmpSpace);⓪$END⓪"END SetWindowSizes;⓪ ⓪ ⓪ VAR gemChar : GemChar;⓪(charValid: BOOLEAN;⓪ ⓪ (*$Z-*)⓪ PROCEDURE readKey (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"BEGIN⓪$gemChar := ch;⓪$charValid := TRUE;⓪$RETURN FALSE⓪"END readKey;⓪ ⓪ (*$Z-*)⓪ PROCEDURE timeDummy (): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"BEGIN⓪$RETURN FALSE⓪"END timeDummy;⓪"⓪ PROCEDURE busyReadGemChar (VAR ch: GemChar; VAR valid: BOOLEAN);⓪ ⓪"VAR worker: ARRAY [1..2] OF EventProc;⓪ ⓪"BEGIN⓪$charValid := FALSE;⓪$worker[1].event := keyboard;⓪$worker[1].keyHdler := readKey;⓪$worker[2].event := timer;⓪$worker[2].timeHdler := timeDummy;⓪$HandleEvents (1, MButtonSet{}, MButtonSet{},⓪2lookForEntry, Rect (0,0,0,0),⓪2lookForEntry, Rect (0,0,0,0),⓪20L,⓪2worker, 0);⓪$⓪$ch := gemChar; valid := charValid;⓪"END busyReadGemChar;⓪"⓪ ⓪((* strings *)⓪ ⓪ (* appendSpcTo -- Fügt Spaces an 'str' an, bis 'Length (str) = i'⓪!*)⓪(⓪ PROCEDURE appendSpcTo (i: CARDINAL; VAR str: ARRAY OF CHAR);⓪ ⓪"VAR l : CARDINAL;⓪"⓪"BEGIN⓪$l := HIGH (str);⓪$IF i < l THEN l := i END;⓪$Append (Space (l - Length (str)), str, voidO);⓪"END appendSpcTo;⓪ ⓪ (* truncCopyStr -- 'source' wird nach 'dest' kopiert. Es gibt 'maxDestLen'⓪!* die Größe von 'dest' an, ist 'source' größer, so wird⓪!* der vordere Teil abgeschnitten und ein '..' vorange-⓪!* stellt.⓪!*)⓪!⓪ PROCEDURE truncCopyString ( source : ARRAY OF CHAR;⓪?maxDestLen: CARDINAL;⓪;VAR dest : ARRAY OF CHAR);⓪ ⓪"VAR sourceLen: CARDINAL;⓪ ⓪"BEGIN⓪$sourceLen := Length (source);⓪$IF sourceLen > maxDestLen THEN⓪&Copy (source, sourceLen - maxDestLen - 2, sourceLen, dest, voidO);⓪&Insert ('..', 0, dest, voidO);⓪$ELSE Assign (source, dest, voidO) END;⓪"END truncCopyString;⓪&⓪&⓪((* lists *)⓪ ⓪ TYPE listApplyProc = PROCEDURE ((*entry: *) ADDRESS,⓪E(*env : *) ADDRESS): BOOLEAN;⓪ ⓪ PROCEDURE applyAtList ( l : List;⓪;(*$Z-*)⓪;work: listApplyProc;⓪;(*$Z=*)⓪;env : ADDRESS;⓪7VAR cut : BOOLEAN);⓪ ⓪"VAR entry : ADDRESS;⓪"⓪"BEGIN⓪$cut := FALSE; ResetList (l);⓪$LOOP⓪&entry := NextEntry (l);⓪&IF entry = NIL THEN EXIT (* EXIT *)⓪&ELSIF ~ work (entry, env) THEN cut := TRUE; EXIT END; (* EXIT *)⓪$END;⓪"END applyAtList;⓪ ⓪ PROCEDURE deleteList (VAR l: List);⓪ ⓪"VAR entry: ADDRESS;⓪"⓪"BEGIN⓪$ResetList (l);⓪$entry := PrevEntry (l);⓪$WHILE entry # NIL DO⓪&RemoveEntry (l, voidO);⓪&entry := CurrentEntry (l);⓪$END;⓪$DeleteList (l, voidO);⓪"END deleteList;⓪ ⓪ (* deleteSimpleList -- Deletes the list 'l' completly. The elements of the⓪!* list must be dynamical allocated variables and would⓪!* all be disposed.⓪!* If 'killCarrier = TRUE' then list-carrier would be⓪!* deleted.⓪!*)⓪ ⓪ PROCEDURE deleteSimpleList (VAR l: List; killCarrier: BOOLEAN);⓪ ⓪"VAR entry: ADDRESS;⓪ ⓪"BEGIN⓪$ResetList (l);⓪$entry := PrevEntry (l);⓪$WHILE entry # NIL DO⓪&RemoveEntry (l, voidO);⓪&DEALLOCATE (entry, 0L);⓪&entry := CurrentEntry (l);⓪$END;⓪$IF killCarrier THEN DeleteList (l, voidO) END;⓪"END deleteSimpleList;⓪ ⓪ ⓪((* 'WindowLists' *)⓪ ⓪ PROCEDURE entrySelected (slotPtr : ptrWdwSlot;⓪9entry : ADDRESS;⓪9selected: BOOLEAN);⓪ ⓪"VAR oldAttrs: AttributesWL;⓪(count : BOOLEAN;⓪"⓪"BEGIN⓪$(* 'count' := "This call causes a change in the number of selected⓪%* entries".⓪%*)⓪$oldAttrs := EntryAttributesWL (slotPtr^.wl, entry);⓪$count := ((selectedWL IN oldAttrs) # selected);⓪$⓪$IF selected THEN⓪&SetEntryAttributesWL (slotPtr^.wl, entry,⓪;oldAttrs + AttributesWL{selectedWL});⓪&IF count THEN⓪(INC (slotPtr^.noSelected)⓪&END;⓪$ELSE⓪&SetEntryAttributesWL (slotPtr^.wl, entry,⓪;oldAttrs - AttributesWL{selectedWL});⓪&IF count THEN⓪(DEC (slotPtr^.noSelected)⓪&END;⓪$END;⓪"END entrySelected;⓪ ⓪ (* firstSelectedEntry -- Returns the first entry of 'slot's window list,⓪!* that is selected. If none exists, NIL is returned.⓪!*)⓪ ⓪ (*$Z-*)⓪ PROCEDURE isNotSelected (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"BEGIN⓪$RETURN ~ (selectedWL IN attrs)⓪"END isNotSelected;⓪"⓪ PROCEDURE firstSelectedEntry (slot: wdwSlotIdx): ADDRESS;⓪ ⓪"VAR result: ADDRESS;⓪(found : BOOLEAN;⓪ ⓪"BEGIN⓪$QueryListWL (wdws[slot]^.wl, forwardWL, isNotSelected, NIL, found, result);⓪$IF ~ found THEN result := NIL END;⓪$⓪$RETURN result⓪"END firstSelectedEntry;⓪"⓪"⓪((* tests *)⓪ ⓪ PROCEDURE withShift (VAR s: SpecialKeySet): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN (leftShiftKey IN s) OR (rightShiftKey IN s)⓪"END withShift;⓪ ⓪ PROCEDURE withBothShifts (VAR s: SpecialKeySet): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN (leftShiftKey IN s) AND (rightShiftKey IN s)⓪"END withBothShifts;⓪ ⓪ PROCEDURE withCtrl (VAR s: SpecialKeySet): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN controlKey IN s⓪"END withCtrl;⓪ ⓪ PROCEDURE withAlt (VAR s: SpecialKeySet): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN alternateKey IN s⓪"END withAlt;⓪ ⓪ PROCEDURE isSubdir (VAR entry: DirEntry): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN subdirAttr IN entry.attr⓪"END isSubdir;⓪"⓪ ⓪ (*$Z-*)⓪ PROCEDURE fastCompare (VAR s1, s2: ARRAY OF CHAR): Relation;⓪ (*$Z=*)⓪"(*$L-*)⓪"BEGIN⓪$(*⓪&IF s1[0] > s2[0] THEN⓪(RETURN greater⓪&ELSIF s1[0] < s2[0] THEN⓪(RETURN less⓪&ELSE⓪(RETURN Compare (s1,s2)⓪&END⓪$*)⓪$ASSEMBLER⓪(MOVE.L -12(A3),A1 ; ADR (s1)⓪(MOVE.L -06(A3),A2 ; ADR (s2)⓪(MOVE.B (A1),D1 ; s1[0]⓪(MOVE.B (A2),D2 ; s2[0]⓪(CMP.B D2,D1⓪(BHI gr⓪(BCS le⓪(JMP Compare ; s1[0] = s2[0]⓪$le: SUBA.W #12,A3⓪(MOVE #less,(A3)+⓪(RTS⓪$gr: SUBA.W #12,A3⓪(MOVE #greater,(A3)+⓪$END⓪"END fastCompare;⓪"(*$L=*)⓪"⓪"⓪((* proc.s for AES objects *)⓪ ⓪ (* formDo -- Is same as 'FormDo', but clears the most significant bit⓪!* of 'exit' (double click).⓪!*)⓪!⓪ PROCEDURE formDo (tree: PtrObjTree; start: CARDINAL; VAR exit: CARDINAL);⓪ ⓪"BEGIN⓪$FormDo (tree, start, exit);⓪$exit := exit MOD (MaxCard DIV 2);⓪"END formDo;⓪"⓪ PROCEDURE drawObject (tree: PtrObjTree; obj: CARDINAL);⓪ ⓪"VAR space : Rectangle;⓪ ⓪"BEGIN⓪$space := AbsObjectSpace (tree, obj);⓪$DrawObject (tree, Root, MaxDepth, space);⓪"END drawObject;⓪"⓪ PROCEDURE hideObj (obj: CARDINAL; hide: BOOLEAN);⓪ ⓪"BEGIN⓪$SetObjFlag (CurrObjTree (), obj, hideTreeFlg, hide);⓪"END hideObj;⓪ ⓪ PROCEDURE hideAndRedrawObj (obj: CARDINAL; hide: BOOLEAN);⓪ ⓪"BEGIN⓪$hideObj (obj, hide);⓪$drawObject (CurrObjTree (), obj);⓪"END hideAndRedrawObj;⓪"⓪0(* Operations on path/file names *)⓪ ⓪ (* killPoint -- Wandelt einen Filenamen, der einen Punkt enthält in einen⓪!* eine Zeichenkette, die aus max. 11 Zeichen besteht. Dabei⓪!* sind die ersten 8 Zeichen Name und die letzten 3 Extension.⓪!*)⓪ ⓪ PROCEDURE killPoint (REF str: ARRAY OF CHAR): NameStr;⓪ ⓪"VAR result: NameStr;⓪*i, j : INTEGER;⓪*l : CARDINAL;⓪*pref, suf: ARRAY [0..7] OF CHAR;⓪ ⓪"BEGIN⓪$SplitName (str, result, suf);⓪$IF suf[0] # 0C THEN⓪&Append (Space (8 - Length (result)), result, voidO);⓪&Append (suf, result, voidO);⓪$END;⓪$RETURN result⓪"END killPoint;⓪ ⓪ PROCEDURE addPoint (VAR str:ARRAY OF CHAR) :String;⓪ ⓪"VAR result : String;⓪*i : INTEGER;⓪"⓪"BEGIN⓪$Assign (str,result, voidO);⓪$IF Length (result) > 8 THEN Insert ('.', 8, result, voidO) END;⓪$EatSpaces (result);⓪$RETURN result;⓪"END addPoint;⓪ ⓪ (* IsSourceName -- Is TRUE, if 'path' descibes a source file else FALSE.⓪!*)⓪ ⓪ PROCEDURE IsSourceName (REF path: ARRAY OF CHAR): BOOLEAN;⓪ ⓪"VAR name : NameStr;⓪(prefix : ARRAY[0..64] OF CHAR;⓪(suffix : ARRAY[0..2] OF CHAR;⓪(sufcnt : MySuf;⓪(isSource: BOOLEAN;⓪(⓪"BEGIN⓪$SplitPath (path, prefix, name);⓪$SplitName (name, name, suffix);⓪$isSource := suffix[0]#'';⓪$IF isSource THEN⓪&sufcnt:= MIN (MySuf);⓪&LOOP⓪(IF StrEqual (suffix, suf[sufcnt]) THEN isSource := FALSE; EXIT⓪(ELSIF sufcnt = MAX (MySuf) THEN EXIT⓪(ELSE INC (sufcnt) END⓪&END;⓪$END;⓪$RETURN isSource⓪"END IsSourceName;⓪ ⓪ PROCEDURE isMSPFile (REF name: ARRAY OF CHAR): BOOLEAN;⓪"VAR n: ARRAY [0..11] OF CHAR;⓪"BEGIN⓪$SplitPath (name, void128, n);⓪$SplitName (n, void128, n);⓪$RETURN StrEqual (n, suf[m2p])⓪"END isMSPFile;⓪"⓪ PROCEDURE IsMBTFile (REF name: ARRAY OF CHAR): BOOLEAN;⓪"VAR n: ARRAY [0..11] OF CHAR;⓪"BEGIN⓪$SplitPath (name, void128, n);⓪$SplitName (n, void128, n);⓪$RETURN StrEqual (n, suf[m2b])⓪"END IsMBTFile;⓪"⓪ PROCEDURE isMakeFile (REF name: ARRAY OF CHAR): BOOLEAN;⓪"VAR n: ARRAY [0..11] OF CHAR;⓪"BEGIN⓪$SplitPath (name, void128, n);⓪$SplitName (n, void128, n);⓪$RETURN StrEqual (n, suf[m2m])⓪"END isMakeFile;⓪"⓪"⓪0(* Alerts *)⓪0(* ====== *)⓪ ⓪ PROCEDURE doAlert (alt: PtrMaxStr);⓪ ⓪"BEGIN⓪$FormAlert (1, alt^, voidC);⓪"END doAlert;⓪"⓪ ⓪ (* multiStringAlert -- Setzt aus den zwei Zeichenketten eine Alarmmeldung⓪!* zusammen und gibt diese aus.⓪!*)⓪ ⓪ PROCEDURE multiStringAlert (REF str1, str2: ARRAY OF CHAR; VAR but: CARDINAL);⓪ ⓪"VAR str : ARRAY[0..255] OF CHAR;⓪"⓪"BEGIN⓪$Concat (str1, str2, str, voidO);⓪$FormAlert (1, str, but);⓪"END multiStringAlert;⓪ ⓪ (* notOKAlert -- Falls die globale Variable 'ok = FALSE' ist, so wird der⓪!* übergebene FileStr 'str' innerhalb einer Alert-Box ange-⓪!* zeigt.⓪!*)⓪!⓪ PROCEDURE notOKAlert (str: PtrMaxStr);⓪ ⓪"BEGIN⓪$IF ~ ok THEN doAlert (str) END;⓪"END notOKAlert;⓪ ⓪ PROCEDURE flexAlert (default: CARDINAL; REF str1,str2:ARRAY OF CHAR; alt:PtrMaxStr;⓪5VAR but:CARDINAL);⓪5⓪ VAR str, strx : ARRAY[0..255] OF CHAR;⓪(i, j : INTEGER;⓪5⓪ BEGIN⓪"i:=Pos ('&',alt^, 0);⓪"j:=Pos ('&',alt^, i + 1);⓪"Copy (alt^, 0,i, str, voidO);⓪"Append (str1, str, voidO);⓪"IF j >= 0 THEN⓪$Copy (alt^, i + 1,j - i - 1, strx, voidO);⓪$Append (strx, str, voidO);⓪$Append (str2, str, voidO);⓪$i:=j;⓪"END;⓪"Copy (alt^, i + 1,Length (alt^) - CARDINAL (i) - 1, strx, voidO);⓪"Append (strx, str, voidO);⓪"FormAlert (default,str, but);⓪ END flexAlert;⓪ ⓪ (* concatPath -- Wie normales Concat', nur wird bei Überlauf des⓪!* Zielstrings ein FormAlert ausgelößt.⓪!* Das 's1, s2' VAR-Parm. sind hat nur Effizenzgründe.⓪!*)⓪!⓪ PROCEDURE concatPath (VAR s1, s2 : ARRAY OF CHAR;⓪6VAR dest : ARRAY OF CHAR;⓪6VAR success: BOOLEAN);⓪"BEGIN⓪$Concat (s1,s2, dest, success);⓪$IF ~ success THEN doAlert (pathToLongAlt) END;⓪"END concatPath;⓪ ⓪ PROCEDURE appendPath (VAR s : ARRAY OF CHAR;⓪6VAR dest : ARRAY OF CHAR;⓪6VAR success: BOOLEAN);⓪6⓪"BEGIN⓪$Append (s, dest, success);⓪$IF ~ success THEN doAlert (pathToLongAlt) END;⓪"END appendPath;⓪ ⓪ PROCEDURE reportOutOfMemory;⓪ ⓪"BEGIN⓪$doAlert (memFullAlt);⓪"END reportOutOfMemory;⓪ ⓪(⓪8(* Desk-Operationen *)⓪8(* ================ *)⓪(⓪ PROCEDURE deskObjSpace (obj: CARDINAL): Rectangle;⓪ ⓪"BEGIN⓪$RETURN AbsObjectSpace (desk, obj)⓪"END deskObjSpace;⓪ ⓪ PROCEDURE redrawDeskObj (obj:CARDINAL);⓪ ⓪"BEGIN⓪$DrawObjInWdw (desk, obj, TRUE, DeskHandle);⓪"END redrawDeskObj;⓪ ⓪ PROCEDURE toggleDeskObj (obj:CARDINAL; VAR newState:BOOLEAN);⓪ ⓪"BEGIN⓪$ToggleObjState (desk, obj, selectObj, FALSE);⓪$redrawDeskObj (obj);⓪$newState := ObjectStateElem (desk, obj, selectObj);⓪"END toggleDeskObj;⓪ ⓪ PROCEDURE selectDeskObj (obj:CARDINAL; state:BOOLEAN; VAR oldState: BOOLEAN);⓪ ⓪"BEGIN⓪$oldState := ObjectStateElem (desk, obj, selectObj);⓪$SetObjStateElem (desk, obj, selectObj, state);⓪$redrawDeskObj (obj);⓪"END selectDeskObj;⓪ ⓪ PROCEDURE careOfDeselectDrive;⓪ ⓪"BEGIN⓪$IF selectedDrive # defaultDrv THEN⓪&toggleDeskObj (drives[selectedDrive].treeIndex, voidO);⓪&selectedDrive := defaultDrv;⓪$END;⓪"END careOfDeselectDrive;⓪ ⓪ PROCEDURE selectDrive (drv: Drive);⓪ ⓪"BEGIN⓪$IF selectedDrive # drv THEN⓪&IF selectedDrive # defaultDrv THEN careOfDeselectDrive END;⓪&selectedDrive := drv;⓪&toggleDeskObj (drives[selectedDrive].treeIndex, voidO);⓪$END;⓪"END selectDrive;⓪ ⓪ (* ensureVisibility -- Ensures, that the given object lies within the⓪!* borders of the desk, e.g. is visible and that it⓪!* is aligned to char. coor.s.⓪!*)⓪!⓪ PROCEDURE ensureVisibility (obj: CARDINAL);⓪ ⓪"PROCEDURE ensure0 (VAR pos,⓪9width : INTEGER;⓪9borderPos,⓪9borderWidth: INTEGER;⓪9alignWidth : CARDINAL);⓪"⓪$BEGIN⓪&pos := pos - pos MOD INTEGER (alignWidth);⓪&WHILE pos + width > borderPos + borderWidth DO⓪(pos := pos DIV 2;⓪&END;⓪&IF pos < borderPos THEN pos := borderPos END;⓪$END ensure0;⓪ ⓪"VAR space: Rectangle;⓪"⓪"BEGIN⓪$space := ObjectSpace (obj);⓪$ensure0 (space.x, space.w, alignedDeskSize.x, alignedDeskSize.w, charWidth);⓪$ensure0 (space.y, space.h, alignedDeskSize.y, alignedDeskSize.h, charHeight);⓪$SetObjSpace (obj, space);⓪"END ensureVisibility;⓪"⓪"⓪ PROCEDURE moveDeskPart (obj:CARDINAL);⓪ ⓪"VAR newPos : Point;⓪"⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$⓪$SetCurrObjTree (desk, FALSE);⓪$hideObj (obj, TRUE);⓪$redrawDeskObj (obj);⓪$⓪$DragBox (ObjectSpaceWithAttrs (desk, obj), deskSize, newPos);⓪$WITH newPos DO⓪&x := x + INTEGER (charWidth) DIV 2; x := x - x MOD INTEGER (charWidth);⓪&y := y + INTEGER (charHeight) DIV 2; y := y - y MOD INTEGER (charHeight);⓪$END;⓪$SetObjSpace (obj, TransRect (ObjectSpace (obj), newPos) );⓪$⓪$hideObj (obj, FALSE);⓪$redrawDeskObj (obj);⓪$⓪$AESUpdateWindow (FALSE);⓪"END moveDeskPart;⓪ ⓪ (* setCurrTextAndCode -- Set the current file.⓪!*)⓪ ⓪ PROCEDURE setCurrTextAndCode (REF str: ARRAY OF CHAR);⓪ ⓪"VAR name : NameStr;⓪(isSrc,⓪(isMXX : BOOLEAN;⓪"⓪"BEGIN⓪$SplitPath (str, void128, name);⓪$⓪$IF name[0]='' THEN⓪&lastFn := '';⓪&TextName := '';⓪&CodeName := '';⓪$ELSE⓪$⓪&isSrc := IsSourceName (str);⓪&isMXX := (IsMBTFile (name) OR isMSPFile (name) OR isMakeFile (name));⓪&IF isSrc OR isMXX THEN⓪(Assign (str, TextName, voidO);⓪(Assign (str, lastFn, voidO);⓪&END;⓪(⓪&IF ~ isSrc OR isMXX THEN Assign (str, CodeName, voidO) END;⓪&⓪¬OKAlert (pathToLongAlt);⓪$END;⓪"END setCurrTextAndCode;⓪ ⓪ (* redrawWorkfile -- Sets the 'WorkField'-values to the objects and⓪!* draws the object.⓪!*)⓪ ⓪ PROCEDURE redrawWorkfile (i: CARDINAL);⓪ ⓪"VAR name: NameStr;⓪ ⓪"BEGIN⓪$WITH WorkField.elems[i] DO⓪&SplitPath (sourceName, void128, name);⓪&SetTextString (desk, nameIdx, name);⓪&SetObjStateElem (desk, identIdx, selectObj,⓪7WorkField.current = INTEGER (i));⓪&hideObj (carrierIdx, ~ used);⓪&redrawDeskObj (carrierIdx);⓪$END;⓪"END redrawWorkfile;⓪"⓪ (* searchDrive -- Ist das Objekt 'obj' ein Drive-Icon, so liefert 'drive'⓪!* die LW-Kennung und 'valid = TRUE'.⓪!* Sonst 'valid = FALSE'.⓪!*)⓪ ⓪ PROCEDURE searchDrive (obj: CARDINAL; VAR drive: Drive; VAR valid: BOOLEAN);⓪"⓪"BEGIN⓪$drive := minDrv;⓪$LOOP⓪&IF drives[drive].available AND (obj = drives[drive].treeIndex)⓪&THEN valid := TRUE; EXIT⓪&ELSIF drive = maxDrv THEN valid := FALSE; EXIT⓪&ELSE INC (drive) END;⓪$END;⓪"END searchDrive;⓪ ⓪ (* searchWorkfile -- If 'obj' is an element of a workfile object, the⓪!* return the workfile index in 'workfileIdx' and⓪!* 'valid = TRUE'.⓪!*)⓪ ⓪ PROCEDURE searchWorkfile ( obj : CARDINAL;⓪:VAR workfileIdx: CARDINAL;⓪:VAR valid : BOOLEAN);⓪ ⓪"BEGIN⓪$workfileIdx := 0; valid := FALSE;⓪$WHILE (workfileIdx < maxWorkFiles) AND ~ valid DO⓪$⓪&WITH WorkField.elems[workfileIdx] DO⓪(valid := ((obj = carrierIdx) OR (obj = identIdx) OR (obj = nameIdx))⓪&END;⓪&⓪&INC (workfileIdx);⓪&⓪$END;⓪$DEC (workfileIdx);⓪"END searchWorkfile;⓪"⓪ PROCEDURE SetGetDeskPositions (f: File; mode: SetGetMode);⓪ ⓪"VAR success: BOOLEAN;⓪ ⓪"PROCEDURE setGetOnePos (obj: CARDINAL);⓪"⓪$VAR loc : Point;⓪"⓪$BEGIN⓪&IF ~ success THEN RETURN END;⓪&⓪&IF mode = setValue THEN⓪&⓪(ReadBlock (f, loc);⓪(IF State (f) < fOK THEN success := FALSE; RETURN END;⓪(WITH loc DO⓪*x := x * INTEGER (charWidth); y := y * INTEGER (charWidth);⓪(END;⓪(SetObjSpace (obj, TransRect (ObjectSpace (obj), loc));⓪(ensureVisibility (obj); (* Icon should be within 'deskSize' *)⓪(⓪&ELSE⓪(⓪(loc := MinPoint (ObjectSpace (obj));⓪(WITH loc DO⓪*x := x DIV INTEGER (charWidth); y := y DIV INTEGER (charWidth);⓪(END;⓪(WriteBlock (f, loc);⓪(IF State (f) < fOK THEN success := FALSE END;⓪(⓪&END;⓪$END setGetOnePos;⓪$⓪"VAR d: Drive;⓪$⓪"BEGIN⓪$success := TRUE;⓪$⓪$SetCurrObjTree (desk, FALSE);⓪$FOR d := minDrv TO maxDrv DO setGetOnePos (drives[d].treeIndex) END;⓪$setGetOnePos (Trash);⓪$setGetOnePos (Edit); setGetOnePos (Compile);⓪$setGetOnePos (Execute); setGetOnePos (Link);⓪$setGetOnePos (Resident); setGetOnePos (Scan);⓪$setGetOnePos (Currfile);⓪$setGetOnePos (Work0); setGetOnePos (Work1);⓪$setGetOnePos (Work2); setGetOnePos (Work3);⓪$setGetOnePos (Work4); setGetOnePos (Work5);⓪$setGetOnePos (Work6); setGetOnePos (Work7);⓪$setGetOnePos (Work8); setGetOnePos (Work9);⓪"END SetGetDeskPositions;⓪ ⓪ (* setWorkfileName -- Assigns the specified workfile a new name.⓪!*)⓪ ⓪ PROCEDURE setWorkfileName (idx: CARDINAL; VAR name: ARRAY OF CHAR);⓪ ⓪"BEGIN⓪$Upper (name);⓪$WITH WorkField.elems[idx]⓪$DO⓪&Assign (name, sourceName, voidO);⓪&codeName := '';⓪$END;⓪$⓪$redrawWorkfile (idx);⓪"END setWorkfileName;⓪"⓪ ⓪8(* menu proc.s *)⓪8(* =========== *)⓪ ⓪ (* setTools -- Verändert den Menubaum so, daß nur noch die in 'ToolField'⓪!* vorhandenen Menu-Tool-Einträge sichtbar sind.⓪!*)⓪ ⓪ PROCEDURE setTools;⓪ ⓪"CONST toolNameLen = 12;⓪ ⓪"VAR f1, f2 : Rectangle;⓪(h : INTEGER;⓪(i : CARDINAL;⓪(str, str2 : FileStr;⓪"⓪"BEGIN⓪"⓪$SetCurrObjTree (menu, FALSE);⓪$h := 0;⓪$FOR i := 1 TO MaxTool DO⓪&WITH ToolField[i]⓪&DO⓪(IF used THEN⓪(⓪*GetTextString (menu, index, str);⓪*SplitPath (name, void128, str2);⓪*Append (Space (toolNameLen - Length (str2)), str2, voidO);⓪*Delete (str, 2, toolNameLen, voidO);⓪*Insert (str2, 2, str, voidO);⓪*MenuText (menu, index, str);⓪*f1 := ObjectSpace (index);⓪*h := h + f1.h⓪*⓪(END;⓪(hideObj (index, NOT used);⓪&END⓪$END;⓪$IF h = 0⓪$THEN⓪&IF NOT ObjectFlag (menu, Mtools, hideTreeFlg)⓪&THEN⓪(hideObj (Mtools, TRUE);⓪(f1 := ObjectSpace (Mibox);⓪(f2 := ObjectSpace (Mtools);⓪(DEC (f1.w, f2.w);⓪(SetObjSpace (Mibox, f1);⓪&END;⓪$ELSE⓪&IF ObjectFlag (menu, Mtools, hideTreeFlg) THEN⓪(hideObj (Mtools, FALSE);⓪(f1 := ObjectSpace (Mibox);⓪(f2 := ObjectSpace (Mtools);⓪(INC (f1.w, f2.w);⓪(SetObjSpace (Mibox, f1);⓪&END;⓪&f1 := ObjectSpace (Tibox);⓪&f1.h := h;⓪&SetObjSpace (Tibox, f1);⓪$END;⓪$⓪"END setTools;⓪ ⓪ PROCEDURE animateMenuTitle (title: CARDINAL; VAR space: Rectangle);⓪ ⓪"BEGIN⓪$NormalTitle (menu, title, FALSE);⓪$space := AbsObjectSpace (menu, title);⓪"END animateMenuTitle;⓪ ⓪ PROCEDURE deAnimateMenuTitle (title: CARDINAL);⓪ ⓪"BEGIN⓪$NormalTitle (menu, title, TRUE);⓪"END deAnimateMenuTitle;⓪"⓪ ⓪0(* Routinen für das Dialogbox-Managment *)⓪0(* ==================================== *)⓪ ⓪((* misc. box primitives *)⓪ ⓪ TYPE arrayOfTwoCards = ARRAY[1..2] OF CARDINAL;⓪ ⓪ PROCEDURE twoCardsInArray (c1, c2: CARDINAL): arrayOfTwoCards;⓪ ⓪"VAR res: arrayOfTwoCards;⓪"⓪"BEGIN⓪$res[1] := c1;⓪$res[2] := c2;⓪$RETURN res⓪"END twoCardsInArray;⓪"⓪ TYPE arrayOfTwoEnumRefs = ARRAY[1..2] OF ObjEnumRef;⓪ ⓪ PROCEDURE twoEnumsInRefArray (obj1 : CARDINAL;⓪>enumValue1: WORD;⓪>obj2 : CARDINAL;⓪>enumValue2: WORD): arrayOfTwoEnumRefs;⓪ ⓪"VAR refs: arrayOfTwoEnumRefs;⓪(i : CARDINAL;⓪(⓪"BEGIN⓪$refs[1].obj := obj1;⓪$refs[1].value := enumValue1;⓪$refs[2].obj := obj2;⓪$refs[2].value := enumValue2;⓪$⓪$RETURN refs⓪"END twoEnumsInRefArray;⓪ ⓪ ⓪((* box handlers *)⓪"⓪ PROCEDURE doCompilerOptionBox;⓪ ⓪"PROCEDURE setGetCompOpts (mode: SetGetMode);⓪"⓪$VAR notProtocol,⓪(found : BOOLEAN;⓪(fname : FileStr;⓪"⓪$BEGIN⓪&WITH CompilerParm DO⓪(SetGetBoxStr (optBox, Oname, mode, name);⓪(Upper (name);⓪(SetGetBoxState (optBox, Oquite, mode, checkObj, shortMsgs);⓪(SetGetBoxState (optBox, Opmark, mode, checkObj, protocol);⓪(IF mode = setValue THEN⓪*notProtocol := ~ protocol;⓪*SetGetBoxState (optBox, Oppath, setValue, disableObj, notProtocol);⓪*SetGetBoxState (optBox, Opwidth, setValue, disableObj, notProtocol);⓪(END;⓪(SetGetBoxStr (optBox, Oargs, mode, CompilerArgs);⓪(SetGetBoxStr (optBox, Oppath, mode, protName);⓪(SetGetBoxCard (optBox, Opwidth, mode, protWidth);⓪(IF protWidth < 10 THEN protWidth := stdProtWidth END;⓪(⓪(SetGetBoxStr (optBox, Ooutput, mode, MainOutputPath);⓪(ValidatePath (MainOutputPath);⓪(SetGetBoxStr (optBox, Olibrary, mode, DefLibName);⓪(IF mode = getValue THEN⓪*Upper (DefLibName);⓪*IF Length (FilePath (DefLibName)) = 0 THEN⓪,SearchFile (DefLibName, DefPaths, fromStart, found, DefLibName);⓪*END⓪(END;⓪(SetGetBoxStr (optBox, Oerror, mode, ErrListFile);⓪(Upper (ErrListFile);⓪&END;⓪$END setGetCompOpts;⓪$⓪ ⓪"VAR space, start : Rectangle;⓪(exit : CARDINAL;⓪"⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$animateMenuTitle (Mparms, start);⓪$⓪$setGetCompOpts (setValue);⓪$PrepareBox (optBox, start, space);⓪$⓪$LOOP⓪&formDo (optBox, Ooutput, exit);⓪&⓪&CASE exit OF⓪(Ook, Oquit: DeselectButton (optBox, exit); EXIT|⓪(Oquite : ToggleCheckBox (optBox, Oquite)|⓪(Opmark : ToggleCheckPlus (optBox, Opmark,⓪EtwoCardsInArray (Oppath, Opwidth))|⓪&ELSE⓪&END;⓪$END;⓪$⓪$IF exit = Ook THEN setGetCompOpts (getValue) END;⓪$⓪$ReleaseBox(optBox, start, space);⓪$deAnimateMenuTitle (Mparms);⓪$AESUpdateWindow (FALSE);⓪"END doCompilerOptionBox;⓪ ⓪ PROCEDURE doLinkerOptionBox;⓪ ⓪"PROCEDURE setGetLinkOpts (mode: SetGetMode);⓪ ⓪$VAR i : CARDINAL;⓪(valid,⓪(notValid: BOOLEAN;⓪(refs : ARRAY [1..4] OF ObjEnumRef;⓪$⓪$BEGIN⓪&SetGetBoxStr (linkBox, Loname, mode, LinkerParm.name);⓪&Upper (LinkerParm.name);⓪&FOR i:= 1 TO 8 DO⓪(WITH linkBoxIdx[i] DO⓪*SetGetBoxState (linkBox, check, mode, checkObj, LinkerParm.linkList[i].valid);⓪*IF mode = setValue THEN⓪,notValid := ~ LinkerParm.linkList[i].valid;⓪,SetGetBoxState (linkBox, path, setValue, disableObj, notValid);⓪*END;⓪*SetGetBoxStr (linkBox, path, mode, LinkerParm.linkList[i].name);⓪(END⓪&END;⓪&valid := (LinkerParm.linkStackSize # 0L); notValid := ~ valid;⓪&SetGetBoxState (linkBox, Lochecks, mode, checkObj, valid);⓪&IF mode = setValue THEN⓪(SetGetBoxState (linkBox, Lostack, setValue, disableObj, notValid);⓪&END;⓪&SetGetBoxLCard (linkBox, Lostack, mode, LinkerParm.linkStackSize);⓪&IF ~ valid THEN LinkerParm.linkStackSize := 0L END;⓪&SetGetBoxCard (linkBox, Lomaxmod, mode, LinkerParm.maxLinkMod);⓪&⓪&SetGetBoxState (linkBox, Lofastld, mode, checkObj, LinkerParm.fastLoad);⓪&SetGetBoxState (linkBox, Lofastco, mode, checkObj, LinkerParm.fastCode);⓪&SetGetBoxState (linkBox, Lofastme, mode, checkObj, LinkerParm.fastMemory);⓪&⓪&SetGetBoxState (linkBox, Losymfil, mode, checkObj, LinkerParm.symbolFile);⓪&⓪&refs[1].obj := Lonoopt;⓪&refs[1].value := WORD (noOptimize);⓪&refs[2].obj := Lonamopt;⓪&refs[2].value := WORD (nameOptimize);⓪&refs[3].obj := Lomiddle;⓪&refs[3].value := WORD (partOptimize);⓪&refs[4].obj := Lofull;⓪&refs[4].value := WORD (fullOptimize);⓪&i := ORD (LinkerParm.optimize);⓪&SetGetBoxEnum (linkBox, refs, mode, i);⓪&LinkerParm.optimize := VAL (LinkMode, i);⓪$END setGetLinkOpts;⓪$⓪ ⓪"VAR space, start : Rectangle;⓪(exit, i : CARDINAL;⓪"⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$animateMenuTitle (Mparms, start);⓪$⓪$setGetLinkOpts (setValue);⓪$PrepareBox (linkBox, start, space);⓪$⓪$LOOP⓪&formDo (linkBox, Root, exit);⓪&⓪&IF (exit = Look) OR (exit = Loquit) THEN⓪(DeselectButton (linkBox, exit); EXIT⓪&ELSIF exit = Lochecks THEN⓪(ToggleCheckPlus (linkBox, Lochecks, Lostack)⓪&ELSIF (exit = Lofastld) OR (exit = Lofastco) OR (exit = Lofastme)⓪&OR (exit = Losymfil) THEN⓪(ToggleCheckBox (linkBox, exit)⓪&ELSE⓪(FOR i := 1 TO 8 DO⓪*IF linkBoxIdx[i].check = exit THEN⓪,ToggleCheckPlus (linkBox, exit, linkBoxIdx[i].path)⓪*END⓪(END;⓪&END;⓪$END;⓪$⓪$IF exit = Look THEN setGetLinkOpts (getValue) END;⓪"⓪$ReleaseBox(linkBox, start,space);⓪$deAnimateMenuTitle (Mparms);⓪$AESUpdateWindow (FALSE);⓪"END doLinkerOptionBox;⓪"⓪ PROCEDURE doScanBox (): BOOLEAN;⓪ ⓪"VAR but : CARDINAL;⓪"⓪"BEGIN⓪$ScanAddr := 0L;⓪$SetTextString (scanBox, Saddr, '');⓪$DoSimpleBox (scanBox, deskObjSpace (Scan), but);⓪$IF but = Sok THEN SetGetBoxLCard (scanBox, Saddr, getValue, ScanAddr) END;⓪$RETURN ScanAddr # 0L⓪"END doScanBox;⓪ ⓪ (* doFileBox -- Inquires a file name from the user, that becomes the new⓪!* work file number 'idx', if 'idx # noCurrentWorkfile',⓪!* else the new current file.⓪!*)⓪ ⓪ PROCEDURE doFileBox (idx: INTEGER);⓪ ⓪"VAR str : FileStr;⓪*but : CARDINAL;⓪*space : Rectangle;⓪"⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$SetCurrObjTree (fileBox, FALSE);⓪$IF idx = noCurrentWorkfile THEN⓪&hideObj (Cfcurr, FALSE);⓪&hideObj (Cfwork, TRUE);⓪&space := deskObjSpace (Cfname);⓪$ELSE⓪&str := WorkField.elems[idx].sourceName;⓪&IF Length (str) > fileBoxLength THEN str := '' END;⓪&SetTextString (fileBox, Cfedit, str);⓪&hideObj (Cfcurr, TRUE);⓪&hideObj (Cfwork, FALSE);⓪&space := deskObjSpace (WorkField.elems[idx].carrierIdx);⓪$END;⓪"⓪$DoSimpleBox (fileBox, space, but);⓪$⓪$IF but = Cfbok THEN⓪&GetTextString (fileBox, Cfedit, str); Upper (str);⓪&SearchFile (str, SrcPaths, fromStart, voidO, str);⓪&IF idx = noCurrentWorkfile THEN setCurrTextAndCode (str)⓪&ELSE setWorkfileName (idx, str) END;⓪$END;⓪$IF idx # noCurrentWorkfile THEN SetTextString (fileBox, Cfedit, '') END;⓪$AESUpdateWindow (FALSE);⓪"END doFileBox;⓪ ⓪ TYPE fNameBoxMode = (requestFolderName, nameConflict);⓪ ⓪ PROCEDURE doFNameBox ( mode: fNameBoxMode;⓪6VAR name: ARRAY OF CHAR;⓪6VAR ok : BOOLEAN);⓪ ⓪"VAR but : CARDINAL;⓪(start : Rectangle;⓪(folder : BOOLEAN;⓪ ⓪"BEGIN⓪$folder := (mode = requestFolderName);⓪$IF folder THEN animateMenuTitle (Mdatei, start) ELSE start.w := -1 END;⓪$⓪$SetCurrObjTree (fNameBox, FALSE);⓪$hideObj (Fdfolder, NOT folder); hideObj (Fdconf, folder);⓪$⓪$SetTextString (fNameBox, Fdname, killPoint (name));⓪$DoSimpleBox (fNameBox, start, but);⓪$ok := (but = Fdok);⓪$IF ok THEN⓪&GetTextString (fNameBox, Fdname, name); Upper (name);⓪&Assign (addPoint (name), name, voidO);⓪$END;⓪$⓪$IF folder THEN deAnimateMenuTitle (Mdatei) END;⓪"END doFNameBox;⓪ ⓪ (*$Z-*)⓪ PROCEDURE doConflictBox (VAR name: ARRAY OF CHAR): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"VAR ok: BOOLEAN;⓪ ⓪"BEGIN⓪$doFNameBox (nameConflict, name, ok); FlushEvents; ShowBee;⓪$IF shellParm.confirmCopy THEN drawObject (confirmBox, Root) END;⓪$RETURN ok⓪"END doConflictBox;⓪ ⓪ PROCEDURE doShellParameterBox;⓪ ⓪"PROCEDURE setGetShellParm (mode: SetGetMode);⓪"⓪$BEGIN⓪&WITH shellParm DO⓪(SetGetBoxEnum (shellParmBox,⓪7twoEnumsInRefArray (Sproot, FALSE, Spcurr, TRUE),⓪7mode, defaultOpenCurrDir);⓪(SetGetBoxState (shellParmBox, Spcopy, mode, checkObj, confirmCopy);⓪(SetGetBoxState (shellParmBox, Spdelete, mode, checkObj, confirmDelete);⓪(SetGetBoxState (shellParmBox, Spbreak, mode, checkObj, breakActive);⓪(SetGetBoxState (shellParmBox, Spallmem, mode, checkObj,⓪8useAllMemForCopy);⓪(SetGetBoxStr (shellParmBox, Spbaname, mode, batchPath);⓪(Upper (batchPath);⓪(SetGetBoxStr (shellParmBox, Sppaname, mode, parameterPath);⓪(Upper (parameterPath);⓪(SetGetBoxStr (shellParmBox, Spscpath, mode, TemporaryPath);⓪(ValidatePath (TemporaryPath);⓪(IF TemporaryPath[0] # HomeSymbol THEN⓪*MakeFullPath (TemporaryPath, voidI);⓪(END;⓪(SetGetBoxStr (shellParmBox, Spmake, mode, makeName);⓪(SetGetBoxStr (shellParmBox, Spfontn, mode, fontSetting.name);⓪(SetGetBoxCard (shellParmBox, Spfonts, mode, fontSetting.size);⓪(Upper (makeName);⓪&END;⓪$END setGetShellParm;⓪$⓪"VAR space, start : Rectangle;⓪(exit : CARDINAL;⓪"⓪"BEGIN⓪$animateMenuTitle (Mparms, start);⓪$⓪$setGetShellParm (setValue);⓪$PrepareBox (shellParmBox, start, space);⓪$⓪$LOOP⓪&formDo (shellParmBox, Root, exit);⓪&⓪&CASE exit OF⓪(Spok, Spquit: DeselectButton (shellParmBox, exit); EXIT|⓪(⓪(Spcopy,⓪(Spdelete,⓪(Spbreak,⓪(Spallmem : ToggleCheckBox (shellParmBox, exit)|⓪&ELSE⓪&END;⓪$END;⓪$⓪$IF exit = Spok THEN⓪&setGetShellParm (getValue);⓪&SetFonts;⓪$END;⓪$⓪$ReleaseBox(shellParmBox, start, space);⓪$deAnimateMenuTitle (Mparms);⓪"END doShellParameterBox;⓪ ⓪ PROCEDURE doEditorParameterBox;⓪ ⓪"PROCEDURE setGetEditorParm (mode: SetGetMode);⓪"⓪$VAR disable: BOOLEAN;⓪"⓪$BEGIN⓪&WITH EditorParm DO⓪(SetGetBoxStr (editorParmBox, Epname, mode, name);⓪(Upper (name);⓪(SetGetBoxState (editorParmBox, Epsearch, mode,⓪8checkObj, searchSources);⓪(SetGetBoxState (editorParmBox, Epstoper, mode,⓪8checkObj, waitOnError);⓪(SetGetBoxState (editorParmBox, Epshtemp, mode,⓪8checkObj, tempShellFile);⓪(disable := ~ tempShellFile;⓪(SetGetBoxState (editorParmBox, Epshname, mode, disableObj, disable);⓪(SetGetBoxStr (editorParmBox, Epshname, mode, tempShellName);⓪(⓪(SetGetBoxState (editorParmBox, Epedtemp, mode,⓪8checkObj, tempEditorFile);⓪(disable := ~ tempEditorFile;⓪(SetGetBoxState (editorParmBox, Epedname, mode, disableObj, disable);⓪(SetGetBoxStr (editorParmBox, Epedname, mode, tempEditorName);⓪ ⓪(SetGetBoxState (editorParmBox, Eparg, mode,⓪8checkObj, passArgument);⓪(SetGetBoxState (editorParmBox, Eparname, mode,⓪8checkObj, passName);⓪(SetGetBoxState (editorParmBox, Eparerro, mode,⓪8checkObj, passErrorText);⓪(SetGetBoxState (editorParmBox, Eparpos, mode,⓪8checkObj, passErrorPos);⓪&END;⓪$END setGetEditorParm;⓪$⓪"VAR start, space: Rectangle;⓪(exit : CARDINAL;⓪ ⓪"BEGIN⓪$animateMenuTitle (Mparms, start);⓪$⓪$setGetEditorParm (setValue);⓪$PrepareBox (editorParmBox, start, space);⓪$⓪$LOOP⓪&formDo (editorParmBox, Root, exit);⓪&⓪&CASE exit OF⓪(Epok, Epquit: DeselectButton (editorParmBox, exit); EXIT|⓪(⓪(Epsearch,⓪(Epstoper,⓪(Eparg,⓪(Eparname,⓪(Eparerro,⓪(Eparpos : ToggleCheckBox (editorParmBox, exit)|⓪(Epshtemp : ToggleCheckPlus (editorParmBox, Epshtemp, Epshname)|⓪(Epedtemp : ToggleCheckPlus (editorParmBox, Epedtemp, Epedname)|⓪&ELSE⓪&END;⓪$END;⓪$⓪$IF exit = Epok THEN setGetEditorParm (getValue) END;⓪"⓪$ReleaseBox(editorParmBox, start, space);⓪$deAnimateMenuTitle (Mparms);⓪"END doEditorParameterBox;⓪"⓪ PROCEDURE showFormatStatus (tracks: CARDINAL; VAR stop: BOOLEAN);⓪ ⓪"VAR ch : GemChar;⓪(valid: BOOLEAN;⓪ ⓪"BEGIN⓪$SetGetBoxCard (formatBox, Foremain, setValue, tracks);⓪$drawObject (formatBox, Foremain);⓪$⓪$busyReadGemChar (ch, valid);⓪$stop := valid AND (ch.scan = undoKey);⓪"END showFormatStatus;⓪"⓪ PROCEDURE doFormatBox;⓪ ⓪"PROCEDURE setGetFormat (mode: SetGetMode; VAR volName: NameStr);⓪"⓪$BEGIN⓪&SetGetBoxEnum (formatBox,⓪5twoEnumsInRefArray (Fosingle, 1, Fodouble, 2),⓪5mode, shellParm.sides);⓪&SetGetBoxEnum (formatBox,⓪5twoEnumsInRefArray (Fo80, 80, Fo81, 81),⓪5mode, shellParm.tracks);⓪&SetGetBoxEnum (formatBox,⓪5twoEnumsInRefArray (Fo9, 9, Fo10, 10),⓪5mode, shellParm.sectors);⓪&IF mode = setValue THEN volName := '' END;⓪&SetGetBoxStr (formatBox, Foname, mode, volName);⓪&volName := killPoint (volName);⓪$END setGetFormat;⓪$⓪"VAR start,⓪(space : Rectangle;⓪(volName : NameStr;⓪(exit : CARDINAL;⓪(drive : FormatDrive;⓪(result : FormatResult;⓪(driveName: CHAR;⓪ ⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$animateMenuTitle (Mdatei, start);⓪$setGetFormat (setValue, volName);⓪$hideObj (Foremain, TRUE);⓪$⓪$PrepareBox (formatBox, start, space);⓪$LOOP⓪&formDo (formatBox, Root, exit);⓪&DeselectButton (formatBox, exit);⓪&⓪&IF exit = Foquit THEN EXIT⓪&ELSE⓪(IF exit = Foa THEN drive := MOSGlobals.drvA; driveName := 'A'⓪(ELSE drive := MOSGlobals.drvB; driveName := 'B' END;⓪(⓪(flexAlert (2, driveName, '', formatAlt, exit);⓪(IF exit = 1 THEN⓪(⓪*ShowBee;⓪*hideObj (Foremain, FALSE);⓪*setGetFormat (getValue, volName);⓪*⓪*WITH shellParm DO⓪,FormatDisk (drive, sides, tracks, sectors, 1, volName,⓪8showFormatStatus, result);⓪*END;⓪*⓪*hideAndRedrawObj (Foremain, TRUE);⓪*ShowArrow;⓪*⓪*IF result # okFR THEN doAlert (formatErrAlt) END;⓪*⓪(END;⓪&END;⓪$END;⓪$⓪$ReleaseBox (formatBox, start, space);⓪$deAnimateMenuTitle (Mdatei);⓪$AESUpdateWindow (FALSE);⓪"END doFormatBox;⓪ ⓪ PROCEDURE doFileInfoBox (VAR entry: DirEntry);⓪ ⓪"VAR name : NameStr;⓪(isProt: BOOLEAN;⓪(⓪"PROCEDURE setGetFileInfo (mode: SetGetMode);⓪"⓪$BEGIN⓪&SetGetBoxStr (fileInfoBox, Finame, mode, name);⓪&SetGetBoxLCard (fileInfoBox, Fisize, mode, entry.size);⓪&SetGetBoxEnum (fileInfoBox, twoEnumsInRefArray (Firw, FALSE,⓪VFiprot, TRUE),⓪5mode, isProt);⓪$END setGetFileInfo;⓪$⓪"VAR start : Rectangle;⓪(but : CARDINAL;⓪ ⓪"BEGIN⓪$animateMenuTitle (Mdatei, start);⓪$⓪$Assign (killPoint (entry.name), name, voidO);⓪$isProt := (readOnlyAttr IN entry.attr);⓪$setGetFileInfo (setValue);⓪$⓪$DoSimpleBox (fileInfoBox, start, but);⓪$⓪$IF but = Fiok THEN⓪&setGetFileInfo (getValue);⓪&Upper (name);⓪&Assign (addPoint (name), entry.name, voidO);⓪&IF isProt THEN INCL (entry.attr, readOnlyAttr)⓪&ELSE EXCL (entry.attr, readOnlyAttr) END;⓪$END;⓪$deAnimateMenuTitle (Mdatei);⓪"END doFileInfoBox;⓪"⓪ PROCEDURE doHelpBox (REF fname: ARRAY OF CHAR);⓪ ⓪"CONST noLines = 14; (* Anzahl der Zeilen in der Hilfe-Box *)⓪(noRows = 65;⓪ ⓪"VAR start, space : Rectangle;⓪(but, i,⓪(visibleLines : CARDINAL;⓪(text : List;⓪(err, end, first : BOOLEAN;⓪(f : File;⓪(str : ptrString;⓪(path : PathStr;⓪ ⓪"PROCEDURE fileErr (): BOOLEAN;⓪"⓪$VAR state: INTEGER;⓪$⓪$BEGIN⓪&state := State (f);⓪&IF (state < fOK) OR (state = fEOF)⓪&THEN⓪)ResetState (f);⓪)FileAlert (state);⓪)RETURN TRUE⓪&ELSE⓪)RETURN FALSE⓪&END;⓪$END fileErr;⓪$⓪"PROCEDURE addLine (obj: CARDINAL);⓪"⓪$BEGIN⓪&IF NOT end THEN⓪(str := NextEntry (text);⓪(IF str = NIL THEN end := TRUE ELSE INC (visibleLines) END;⓪&END;⓪&IF end THEN SetTextString (helpBox, obj, '')⓪&ELSE⓪(IF Length (str^) > noRows THEN⓪*Delete (str^, noRows, Length (str^) - noRows, voidO);⓪(END;⓪(SetTextString (helpBox, obj, str^);⓪&END;⓪$END addLine;⓪$⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$animateMenuTitle (Minfo, start);⓪$⓪$(* Lies Hilfe-Datei ein.⓪%*)⓪ ⓪$Concat (ShellPath, fname, path, voidO);⓪$CreateList (text, err);⓪$IF err THEN⓪&reportOutOfMemory;⓪&deAnimateMenuTitle (Minfo);⓪&AESUpdateWindow (FALSE);⓪&RETURN⓪$END;⓪$ShowBee;⓪$Open (f, path, readSeqTxt);⓪$IF (State (f)) # fOK⓪$THEN⓪&doAlert (noHelpAlt);⓪&DeleteList (text, voidO);⓪&deAnimateMenuTitle (Minfo);⓪&ShowArrow;⓪&AESUpdateWindow (FALSE);⓪&RETURN⓪$END;⓪$LOOP⓪$⓪&NEW (str);⓪&IF str = NIL THEN reportOutOfMemory; EXIT END;⓪&IF fileErr () THEN DISPOSE (str); EXIT END;⓪&Text.ReadString (f, str^);⓪&AppendEntry (text, str, err);⓪&IF err THEN reportOutOfMemory; DISPOSE (str); EXIT END;⓪&IF fileErr () THEN EXIT END;⓪&Text.ReadLn (f);⓪$⓪$END;⓪$Close (f);⓪$ShowArrow;⓪$AESUpdateWindow (FALSE);⓪$⓪$(* Zeige Hilfe-Datei an.⓪%*)⓪%⓪$ResetList (text);⓪$but := Hpnext; visibleLines := 0; first := TRUE;⓪$REPEAT⓪$⓪&IF but = Hpprev THEN⓪(IF EndOfList (text) THEN INC (visibleLines) END;⓪(FOR i := 1 TO noLines + visibleLines DO voidADR := PrevEntry (text) END;⓪&END;⓪&SetObjStateElem (helpBox, Hpprev, disableObj, EndOfList (text));⓪&end := FALSE; visibleLines := 0;⓪&addLine (Hpmsg1); addLine (Hpmsg2); addLine (Hpmsg3);⓪&addLine (Hpmsg4); addLine (Hpmsg5); addLine (Hpmsg6);⓪&addLine (Hpmsg7); addLine (Hpmsg8); addLine (Hpmsg9);⓪&addLine (Hpmsg10); addLine (Hpmsg11); addLine (Hpmsg12);⓪&addLine (Hpmsg13); addLine (Hpmsg14);⓪&SetObjStateElem (helpBox, Hpnext, disableObj, EndOfList (text));⓪&SetObjFlag (helpBox, Hpnext, defaultFlg, NOT EndOfList (text));⓪&SetObjFlag (helpBox, Hpquit, defaultFlg, EndOfList (text));⓪&⓪&IF first THEN PrepareBox (helpBox, start, space); first := FALSE⓪&ELSE DrawObject (helpBox, Root, MaxDepth, space) END;⓪&formDo (helpBox, Root, but);⓪&DeselectButton (helpBox, but);⓪&⓪$UNTIL but = Hpquit;⓪$ReleaseBox (helpBox, start, space);⓪$⓪$(* Lösche Hilfe-Datei.⓪%*)⓪$deleteSimpleList (text, TRUE);⓪$⓪$deAnimateMenuTitle (Minfo);⓪"END doHelpBox;⓪ ⓪ ⓪ PROCEDURE doInfoBox;⓪ ⓪ (*⓪!* Umgebungsinformationen⓪!*)⓪ ⓪"VAR dftPath,⓪(codeFile : FileStr;⓪(dftPathEditable : BOOLEAN;⓪(⓪"PROCEDURE setGetInfo (mode: SetGetMode);⓪"⓪$VAR lc: LONGCARD; s: ARRAY [0..13] OF CHAR;⓪"⓪$BEGIN⓪&SetObjFlag (infoBox, Inpath, editFlg, dftPathEditable);⓪&SetGetBoxStr (infoBox, Inpath, mode, dftPath);⓪&SetGetBoxLCard (infoBox, Instack, mode, DefaultStackSize);⓪&SetGetBoxStr (infoBox, Inmkfile, mode, MakeFileName);⓪&SetGetBoxState (infoBox, Stponrtn, mode, checkObj, shellParm.waitOnReturn);⓪&Upper (MakeFileName);⓪&IF mode = setValue THEN⓪(lc := MemAvail ();⓪(SetGetBoxLCard (infoBox, Inblock, setValue, lc);⓪(lc := AllAvail ();⓪(SetGetBoxLCard (infoBox, Inall, setValue, lc);⓪(SetGetBoxStr (infoBox, Ihome, setValue, HomePath);⓪(SetGetBoxStr (infoBox, Incode, setValue, codeFile);⓪(SetGetBoxLCard (infoBox, Inlength, setValue, LastCodeSize);⓪(IF UsedFormat = IEEEReal THEN⓪*IF RealMode = 2 THEN⓪,s:= 'IEEE (ST-FPU)'⓪*ELSE⓪,s:= 'IEEE (TT-FPU)'⓪*END⓪(ELSE⓪*s:= 'Megamax'⓪(END;⓪(SetGetBoxStr (infoBox, Realform, setValue, s);⓪&END;⓪$END setGetInfo;⓪$⓪"VAR space, start : Rectangle;⓪(exit : CARDINAL;⓪(res : INTEGER;⓪ ⓪"BEGIN⓪$animateMenuTitle (Minfo, start);⓪$⓪$GetDefaultPath (dftPath);⓪$dftPathEditable := (maxDftPathInfo >= Length (dftPath));⓪$truncCopyString (dftPath, maxDftPathInfo, dftPath);⓪$truncCopyString (LastCodeName, maxCodeFileInfo, codeFile);⓪$setGetInfo (setValue);⓪$⓪$PrepareBox (infoBox, start, space);⓪$LOOP⓪&formDo (infoBox, Root, exit);⓪&CASE exit OF⓪(Inok, Inquit: DeselectButton (infoBox, exit); EXIT|⓪(Stponrtn : ToggleCheckBox (infoBox, exit)|⓪&ELSE⓪&END;⓪$END;⓪$ReleaseBox(infoBox, start, space);⓪$⓪$IF exit = Inok THEN⓪&setGetInfo (getValue);⓪&IF dftPathEditable THEN⓪(ValidatePath (dftPath);⓪(ReplaceHome (dftPath);⓪(SetDefaultPath (dftPath, res);⓪(FileAlert (res);⓪&END;⓪$END;⓪$deAnimateMenuTitle (Minfo);⓪"END doInfoBox;⓪"⓪ ⓪0(* Exportierte Box-Funktionen *)⓪ ⓪ PROCEDURE ScanBox (VAR name: ARRAY OF CHAR): BOOLEAN;⓪ ⓪"VAR but: CARDINAL;⓪ ⓪"BEGIN⓪$SetTextString (sNameBox, Snedit, name);⓪$DoSimpleBox (sNameBox, deskObjSpace (Scan), but);⓪$CASE but OF⓪&Snok : GetTextString(sNameBox, Snedit, name); Upper (name)|⓪&Snwork: WITH WorkField DO⓪0IF current >= 0⓪0THEN Assign(elems[current].sourceName, name, voidO)⓪0ELSE Assign ('', name, voidO); END;⓪.END|⓪$ELSE⓪$END;⓪$RETURN but # Snquit⓪"END ScanBox;⓪ ⓪ PROCEDURE RequestArg (VAR name: ARRAY OF CHAR);⓪ ⓪"BEGIN⓪$SetTextString (argBox, Aedit, name);⓪$DoSimpleBox (argBox, Rect (0, 0, 50, 30), voidC);⓪$GetTextString (argBox, Aedit, name);⓪"END RequestArg;⓪ ⓪ TYPE TellMode = (initTell, newTellValue, endTell);⓪ ⓪ PROCEDURE TellLoading (mode: TellMode; REF fname: ARRAY OF CHAR);⓪ ⓪"VAR start : Rectangle;⓪"⓪"BEGIN⓪$start := Rect (0, 0, 50, 30);⓪$⓪$CASE mode OF⓪&initTell : SetTextString (loadBox, Lfname, '');⓪<PrepareBox (loadBox, start, tellSpace);⓪<ShowBee|⓪<⓪&newTellValue : SetTextString (loadBox, Lfname, ' ');⓪<drawObject (loadBox, Lfname);⓪<SetTextString (loadBox, Lfname, FileName (fname));⓪<drawObject (loadBox, Lfname)|⓪<⓪&endTell : ReleaseBox (loadBox, start, tellSpace);⓪<ShowArrow|⓪$END;⓪"END TellLoading;⓪ ⓪ ⓪8(* window managment *)⓪8(* ================ *)⓪(⓪((* misc. *)⓪ ⓪ CONST onlyOneSelected = 0L;⓪(multipleSelect = 1L;⓪(pickUpSelect = 2L;⓪(pickUpMultiple = multipleSelect + pickUpSelect;⓪(doubleClickSelect = 4L;⓪(⓪ ⓪ (* scanSlots -- calls the proc. 'match' for every window slot, until⓪!* 'match' supplies TRUE. Therefor the result is:⓪!*⓪!* [(match (slot) = TRUE) AND (success = TRUE)] OR⓪!* [(<for all> slot <elem> wdwSlotIdx : match (slot) = FALSE) AND⓪!* (success = FALSE)]⓪!*)⓪ ⓪ TYPE scanProc = PROCEDURE ((*slot: *) wdwSlotIdx): BOOLEAN;⓪ ⓪ PROCEDURE scanSlots ((*$Z-*)⓪9match : scanProc;⓪5(*$Z=*)⓪5VAR slot : wdwSlotIdx;⓪5VAR success: BOOLEAN);⓪"BEGIN⓪$slot := MIN (wdwSlotIdx);⓪$LOOP⓪&IF match (slot) THEN success := TRUE; EXIT⓪&ELSIF slot = MAX (wdwSlotIdx) THEN success := FALSE; EXIT⓪&ELSE INC (slot) END;⓪$END;⓪"END scanSlots;⓪"⓪ PROCEDURE slotIsFree (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN ~ wdws[slot]^.used⓪"END slotIsFree;⓪"⓪ (*⓪ PROCEDURE slotIsUsed (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN wdws[slot]^.used⓪"END slotIsUsed;⓪!*)⓪ ⓪ PROCEDURE isDirWdw (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$WITH wdws[slot]^ DO RETURN used AND (kind = dirWdw)⓪$END;⓪"END isDirWdw;⓪"⓪ PROCEDURE isModWdw (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$WITH wdws[slot]^ DO RETURN used AND (kind = modWdw)⓪$END;⓪"END isModWdw;⓪"⓪ PROCEDURE isTopWdw (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN IsTopWindowWL (wdws[slot]^.wl)⓪"END isTopWdw;⓪ ⓪ PROCEDURE hasSelectedEntries (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN wdws[slot]^.noSelected > 0⓪"END hasSelectedEntries;⓪"⓪ ⓪ (*$Z-*)⓪ PROCEDURE deselectEntry (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"BEGIN⓪$IF selectedWL IN attrs THEN entrySelected (env, entry, FALSE) END;⓪$RETURN TRUE⓪"END deselectEntry;⓪"⓪ PROCEDURE deselectWList (slotPtr: ptrWdwSlot);⓪ ⓪"BEGIN⓪$QueryListWL (slotPtr^.wl, forwardWL, deselectEntry, slotPtr,⓪1voidO, voidADR);⓪"END deselectWList;⓪ ⓪ ⓪ PROCEDURE selectEntry (wl : WindowList;⓪7entry,⓪7env : ADDRESS;⓪7selMode: LONGCARD);⓪ ⓪"VAR slotPtr : ptrWdwSlot;⓪(slot : wdwSlotIdx;⓪(success,⓪(alreadySelected,⓪(err : BOOLEAN;⓪(entry2 : ADDRESS;⓪ ⓪"BEGIN⓪$slotPtr := ptrWdwSlot (env);⓪$⓪$careOfDeselectDrive;⓪$⓪$WITH slotPtr^ DO⓪&alreadySelected := selectedWL IN EntryAttributesWL (wl, entry);⓪&⓪&scanSlots (hasSelectedEntries, slot, success);⓪&IF success AND ((selMode = onlyOneSelected) OR (slotPtr # wdws[slot])⓪6OR (selMode = doubleClickSelect)⓪6OR ((selMode = pickUpSelect) AND ~ alreadySelected) )⓪&THEN⓪(deselectWList (wdws[slot])⓪&END;⓪$⓪&entrySelected (slotPtr, entry,⓪5NOT alreadySelected⓪5OR (alreadySelected AND (selMode # multipleSelect))⓪4);⓪$END;⓪"END selectEntry;⓪"⓪"⓪((* directory windows *)⓪ ⓪ VAR dirList : List;⓪ ⓪ (*$Z-*)⓪ PROCEDURE insertDirEntry (REF path: ARRAY OF CHAR; entry: DirEntry): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"VAR data, e : ptrDirEntry;⓪(ins, err: BOOLEAN;⓪ ⓪"BEGIN⓪$IF (entry.name[0] # '.')⓪'AND (entry.attr * FileAttrSet{hiddenAttr, systemAttr, volLabelAttr}⓪,= FileAttrSet{})⓪$THEN⓪$⓪&NEW (data); (* alloc. carrier *)⓪&data^.entry := entry;⓪&data^.entry.attr := data^.entry.attr * FileAttrSet{subdirAttr};⓪&data^.str := '';⓪$⓪&(* alphabetic order, folders first⓪'*)⓪'⓪&ResetList (dirList);⓪&LOOP⓪(e := NextEntry (dirList);⓪(IF e = NIL THEN⓪(⓪*AppendEntry (dirList, data, err);⓪*IF err THEN reportOutOfMemory; RETURN FALSE END;⓪*EXIT⓪*⓪(ELSE⓪*ins := (subdirAttr IN data^.entry.attr)⓪1AND NOT (subdirAttr IN e^.entry.attr);⓪*IF ~ ins AND (data^.entry.attr = e^.entry.attr)⓪*THEN⓪,ins := (fastCompare (data^.entry.name, e^.entry.name) = less)⓪*END;⓪*IF ins THEN⓪*⓪,e := PrevEntry (dirList);⓪,InsertEntry (dirList, data, err);⓪,IF err THEN reportOutOfMemory; RETURN FALSE END;⓪,EXIT⓪,⓪*END;⓪(END;⓪&END;⓪$⓪$END;⓪&⓪$RETURN TRUE⓪"END insertDirEntry;⓪ ⓪ FORWARD dirEntryToStr (entry, env: ADDRESS; VAR str: MaxStr);⓪ ⓪ FORWARD closeDirWdw (wl: WindowList; env: ADDRESS);⓪ ⓪ PROCEDURE createDirList (slotPtr: ptrWdwSlot; VAR success:BOOLEAN);⓪ ⓪"VAR err : BOOLEAN;⓪&wildName: Str128;⓪&res : INTEGER;⓪"⓪"BEGIN⓪$ShowBee;⓪$⓪$WITH slotPtr^ DO⓪$⓪&Concat (path, '*.*', wildName, success);⓪&IF ~ success THEN doAlert (pathToLongAlt); ShowArrow; RETURN END;⓪&⓪&CreateList (dirList, err); success := ~ err;⓪&IF err THEN reportOutOfMemory; ShowArrow; RETURN END;⓪$⓪&DirQuery (wildName, FileAttrSet{subdirAttr}, insertDirEntry, res);⓪&IF (res # fFileNotFound) AND (res # fOK)⓪&THEN⓪(FileAlert (res);⓪&END;⓪&⓪&SetListWL (wl, dirList,⓪5dirEntryToStr, closeDirWdw, selectEntry, slotPtr,⓪5dirWdwWidth, path);⓪5⓪$END;⓪$⓪$ShowArrow;⓪"END createDirList;⓪ ⓪ PROCEDURE deleteDirList (slotPtr: ptrWdwSlot);⓪ ⓪"VAR l: List;⓪ ⓪"BEGIN⓪$GetListWL (slotPtr^.wl, l);⓪$deleteSimpleList (l, TRUE);⓪$slotPtr^.noSelected := 0;⓪"END deleteDirList;⓪ ⓪ ⓪ (* dirEntryToString -- Wandelt einen Directoryeintrag in einen String um.⓪!*)⓪!⓪ PROCEDURE dirEntryToStr (entry, env: ADDRESS; VAR str: MaxStr);⓪ ⓪"CONST subdirChar = 7C; (* Das Ordnerzeichen *)⓪ ⓪"VAR dataPtr : ptrDirEntry;⓪(slotPtr : ptrWdwSlot;⓪(⓪(pre, suf : ARRAY[0..7] OF CHAR;⓪(pos : CARDINAL;⓪(str0 : String;⓪"⓪"PROCEDURE extendStr (offset: CARDINAL);⓪"⓪$BEGIN⓪&pos := pos + offset;⓪&appendSpcTo (pos, str);⓪$END extendStr;⓪$⓪"⓪"BEGIN⓪$dataPtr := ptrDirEntry (entry);⓪$slotPtr := ptrWdwSlot (env);⓪$⓪$IF Empty (dataPtr^.str) THEN⓪$⓪&WITH dataPtr^.entry DO⓪&⓪(pos := 0; str := '';⓪(⓪(IF isSubdir (dataPtr^.entry) THEN (* folder *)⓪*Concat (' ',subdirChar, str, voidO)⓪(END;⓪(extendStr (dirLeftBorder);⓪(⓪(SplitName (name, pre, suf);⓪(Append (pre, str, voidO); (* name *)⓪(extendStr (dirNameLen);⓪(⓪(Append (suf, str, voidO); (* extension *)⓪(extendStr (dirExtLen + dirGap);⓪(⓪(IF ~ isSubdir (dataPtr^.entry) THEN (* size *)⓪*Append (CardToStr (size, dirSizeLen), str, voidO);⓪(END;⓪(extendStr (dirSizeLen + dirGap);⓪(⓪(DateToText (date, '', str0); (* date *)⓪(Append (str0, str, voidO);⓪(extendStr (dirDateLen + dirGap);⓪(⓪(TimeToText (time, '', str0); (* time *)⓪(Delete (str0, 5, 3, voidO);⓪(Append (str0, str, voidO);⓪(extendStr (dirTimeLen + dirRightBorder);⓪(⓪&END;⓪&⓪&Assign (str, dataPtr^.str, voidO);⓪$⓪$ELSE Assign (dataPtr^.str, str, voidO) END;⓪$⓪"END dirEntryToStr;⓪(⓪ PROCEDURE closeDirWdw (wl: WindowList; env: ADDRESS);⓪ ⓪"VAR slotPtr: ptrWdwSlot;⓪(i, j,⓪(len : INTEGER;⓪ ⓪"BEGIN⓪$slotPtr := ptrWdwSlot (env);⓪$⓪$deleteDirList (slotPtr);⓪$ViewLineWL (slotPtr^.wl, 1);⓪&⓪$WITH slotPtr^ DO⓪$⓪&len := INTEGER (Length (path));⓪&i := PosLen ('\', path, 0);⓪&j := PosLen ('\', path, i + 1);⓪&IF j = len THEN (* close root => close window *)⓪&⓪(used := FALSE;⓪(HideWindowWL (wl);⓪(⓪&ELSE (* close folder *)⓪&⓪(WHILE j < (len - 1) DO⓪*i := j;⓪*j := PosLen ('\', path, i + 1);⓪(END;⓪(Delete (path, i + 1, j - i, voidO);⓪(createDirList (slotPtr, voidO);⓪(⓪&END;⓪$END;⓪"END closeDirWdw;⓪ ⓪ (* openDirWdw -- Opens a new directory window on drive 'drive'. Depending on⓪!* on 'openCurrDir' the root or the current path of the drive⓪!* is displayed.⓪!* Result is the used window slot in 'slot' and 'success = TRUE'⓪!* if no error occured.⓪!*)⓪"⓪ PROCEDURE openDirWdw (VAR slot : wdwSlotIdx;⓪:driv : Drive;⓪:openCurrDir: BOOLEAN);⓪ ⓪"VAR str : Str128;⓪(drive : MOSGlobals.Drive;⓪(result : INTEGER;⓪(success: BOOLEAN;⓪ ⓪"BEGIN⓪$drive:= VAL (MOSGlobals.Drive, ORD (driv));⓪$⓪$scanSlots (slotIsFree, slot, success);⓪$IF ~ success THEN doAlert (noWindAlt); RETURN END;⓪$⓪$WITH wdws[slot]^ DO (* init. *)⓪$⓪&Assign (DriveToStr (drive), path, voidO);⓪&IF openCurrDir⓪&THEN⓪(GetCurrentDir (drive, str);⓪(SetCurrentDir (drive, str, result);⓪(IF result < fOK⓪(THEN⓪*openCurrDir := FALSE;⓪*IF str[1] = 0C THEN RETURN END; (* RETURN, if 'str' describes root *)⓪(END;⓪&END;⓪&IF openCurrDir⓪&THEN⓪(Append (str, path, success);⓪&ELSE⓪(Append ('\', path, success);⓪&END;⓪&⓪&kind := dirWdw;⓪&⓪$END;⓪$⓪$(* create and display the 'WindowList'⓪%*)⓪$⓪$createDirList (wdws[slot], success); IF ~ success THEN RETURN END;⓪$ShowBee; ShowWindowWL (wdws[slot]^.wl); ShowArrow;⓪$IF StateWL (wdws[slot]^.wl) = cantShowWL THEN⓪&ResetStateWL (wdws[slot]^.wl);⓪&deleteDirList (wdws[slot]);⓪&doAlert (noWindAlt);⓪&RETURN⓪$END;⓪$wdws[slot]^.used := TRUE;⓪"END openDirWdw;⓪"⓪ PROCEDURE openFolder (slotPtr: ptrWdwSlot; data: ptrDirEntry);⓪ ⓪"VAR newPath : Str128;⓪(success : BOOLEAN;⓪ ⓪"BEGIN⓪$IF isSubdir (data^.entry) THEN⓪$⓪&concatPath (slotPtr^.path, data^.entry.name, newPath, success);⓪&IF success THEN⓪(Append ('\', newPath, success);⓪(IF ~ success THEN doAlert (pathToLongAlt) END;⓪&END;⓪&⓪&IF success THEN⓪&⓪(deleteDirList (slotPtr);⓪(ViewLineWL (slotPtr^.wl, 1);⓪(Assign (newPath, slotPtr^.path, voidO);⓪(createDirList (slotPtr, success);⓪(⓪&END;⓪&⓪$END;⓪"END openFolder;⓪"⓪"⓪((* module windows *)⓪ ⓪ (* insertModEntry -- Inserts one module alphabetical in the 'modList'.⓪!* 'modFlag = TRUE' means to insert every module, else⓪!* there are only loaded moduls inserted.⓪!*)⓪ ⓪ VAR modList: List;⓪(modFlag: BOOLEAN;⓪ ⓪ PROCEDURE insertModEntry (REF codeName: ARRAY OF CHAR;⓪>codeAddr: ADDRESS;⓪>codeLen : LONGCARD;⓪>varAddr : ADDRESS;⓪>varLen : LONGCARD;⓪:REF fileName: ARRAY OF CHAR;⓪>module : BOOLEAN;⓪>loaded : BOOLEAN;⓪>resident: BOOLEAN );⓪ ⓪"VAR data, e: ptrModEntry;⓪(err : BOOLEAN;⓪"⓪"BEGIN⓪$IF modFlag OR loaded THEN⓪$⓪&NEW (data);⓪&IF data = NIL THEN reportOutOfMemory; RETURN END;⓪&⓪&WITH data^ DO⓪(Assign (codeName, name, voidO);⓪(lenOfCode := codeLen;⓪(lenOfVar := varLen;⓪(isModul := module;⓪(wasLoaded := loaded;⓪(isResident := resident;⓪&END;⓪&⓪&ResetList (modList);⓪&LOOP⓪(e := NextEntry (modList);⓪(IF e = NIL THEN⓪(⓪*AppendEntry (modList, data, err);⓪*IF err THEN reportOutOfMemory; RETURN END;⓪*EXIT⓪*⓪(ELSE⓪(⓪*IF fastCompare (data^.name, e^.name) = less THEN⓪*⓪,e := PrevEntry (modList);⓪,InsertEntry (modList, data, err);⓪,IF err THEN reportOutOfMemory; RETURN END;⓪,EXIT⓪,⓪*END;⓪(END;⓪&END;⓪&⓪$END;⓪"END insertModEntry;⓪ ⓪ FORWARD modEntryToStr (entry, env: ADDRESS; VAR str: MaxStr);⓪ ⓪ FORWARD closeModWdw (wl: WindowList; env: ADDRESS);⓪ ⓪ PROCEDURE createModList (slotPtr: ptrWdwSlot; VAR success:BOOLEAN);⓪ ⓪"VAR err : BOOLEAN;⓪(w : CARDINAL;⓪(name: FileStr;⓪"⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$ShowBee;⓪$⓪$CreateList (modList, err); success := ~ err;⓪$IF err THEN reportOutOfMemory; ShowArrow; AESUpdateWindow (FALSE); RETURN END;⓪$WITH slotPtr^ DO⓪$⓪&modFlag := all;⓪$⓪&ModQuery (insertModEntry);⓪&⓪&IF all THEN⓪(Assign (modWdwTitleAll, name, voidO);⓪(w := modWdwWidthAll;⓪&ELSE⓪(Assign (modWdwTitle, name, voidO);⓪(w := modWdwWidth;⓪&END;⓪&SetListWL (wl, modList,⓪5modEntryToStr, closeModWdw, selectEntry, slotPtr,⓪5w, name);⓪5⓪$END;⓪$⓪$ShowArrow;⓪$AESUpdateWindow (FALSE);⓪"END createModList;⓪ ⓪ PROCEDURE deleteModList (slotPtr: ptrWdwSlot);⓪ ⓪"VAR l: List;⓪"⓪"BEGIN⓪$GetListWL (slotPtr^.wl, l);⓪$deleteSimpleList (l, TRUE);⓪$slotPtr^.noSelected := 0;⓪"END deleteModList;⓪"⓪ ⓪ PROCEDURE modEntryToStr (entry, env: ADDRESS; VAR str: MaxStr);⓪ ⓪"VAR dataPtr: ptrModEntry;⓪(slotPtr: ptrWdwSlot;⓪(⓪(pos : CARDINAL;⓪"⓪"PROCEDURE extendStr (offset: CARDINAL);⓪"⓪$BEGIN⓪&pos := pos + offset;⓪&appendSpcTo (pos, str);⓪$END extendStr;⓪"⓪"PROCEDURE appFlg (REF text: ARRAY OF CHAR; len: CARDINAL; flg: BOOLEAN);⓪6⓪$BEGIN⓪&extendStr (modGap);⓪&⓪&IF flg THEN Append (text, str, voidO) END;⓪&extendStr (len);⓪$END appFlg;⓪$⓪"⓪"BEGIN⓪$dataPtr := ptrModEntry (entry);⓪$slotPtr := ptrWdwSlot (env);⓪$⓪$WITH dataPtr^ DO⓪$⓪&pos := 0; str := '';⓪&⓪&Assign (name, str, voidO);⓪&extendStr (maxModNameLen + modGap);⓪&⓪&Append (CardToStr (lenOfCode, lCardLog), str, voidO);⓪&extendStr (lCardLog + modGap);⓪&⓪&Append (CardToStr (lenOfVar, lCardLog), str, voidO);⓪&extendStr (lCardLog);⓪&⓪&appFlg (modModFlag, modModLen, isModul);⓪&IF slotPtr^.all THEN appFlg (modLoadFlag, modLoadLen, wasLoaded) END;⓪&appFlg (modRsdFlag, modRsdLen, isResident);⓪&⓪$END;⓪$⓪"END modEntryToStr;⓪ ⓪ PROCEDURE closeModWdw (wl: WindowList; env: ADDRESS);⓪ ⓪"VAR slotPtr: ptrWdwSlot;⓪ ⓪"BEGIN⓪$slotPtr := ptrWdwSlot (env);⓪$⓪$deleteModList (slotPtr);⓪$WITH slotPtr^⓪$DO⓪&used := FALSE;⓪&HideWindowWL (wl);⓪$END;⓪"END closeModWdw;⓪"⓪ PROCEDURE openModWdw (VAR slot : wdwSlotIdx;⓪:allMods : BOOLEAN);⓪"⓪"VAR success: BOOLEAN;⓪"⓪"BEGIN⓪$scanSlots (slotIsFree, slot, success);⓪$IF ~ success THEN doAlert (noWindAlt); RETURN END;⓪$⓪$WITH wdws[slot]^ DO (* init. *)⓪$⓪&all := allMods;⓪&⓪&kind := modWdw;⓪&used := TRUE;⓪&⓪$END;⓪$⓪$(* create and display the 'WindowList'⓪%*)⓪$⓪$AESUpdateWindow (TRUE);⓪$createModList (wdws[slot], success); IF ~ success THEN AESUpdateWindow (FALSE); RETURN END;⓪$ShowBee; ShowWindowWL (wdws[slot]^.wl); ShowArrow;⓪$IF StateWL (wdws[slot]^.wl) = cantShowWL THEN⓪&ResetStateWL (wdws[slot]^.wl);⓪&doAlert (noWindAlt);⓪$END;⓪$AESUpdateWindow (FALSE);⓪"END openModWdw;⓪"⓪"⓪((* general window proc.s *)⓪ ⓪ (* getSelectedName -- Ermittelt die zu dem aktuell selektierten Fenster-⓪!* eintrag gehörende Zeichenkette.⓪!* Zusätzlich wird noch der Typ des Eintrages geliefert.⓪!* Ist kein Eintrag oder sind mehrere selektiert, so⓪!* wird 'kind = noNK' geliefert.⓪!* 'slot' liefert den Fensterslot, in dem sich der Eintrag⓪!* befindet.⓪!*)⓪ ⓪ TYPE nameKind = (noNK, fileNK, folderNK, modulNK);⓪ ⓪ PROCEDURE getSelectedName (VAR name : ARRAY OF CHAR;⓪;VAR slot : wdwSlotIdx;⓪;VAR kindOfName: nameKind);⓪ ⓪"VAR somethingSelected: BOOLEAN;⓪(entry : ADDRESS;⓪(dirEntryPtr : ptrDirEntry;⓪(modEntryPtr : ptrModEntry;⓪(success : BOOLEAN;⓪ ⓪"BEGIN⓪$scanSlots (hasSelectedEntries, slot, somethingSelected);⓪$IF somethingSelected AND (wdws[slot]^.noSelected = 1) THEN⓪$⓪&WITH wdws[slot]^ DO⓪(entry := firstSelectedEntry (slot);⓪(IF kind = dirWdw THEN (* dir. wdw *)⓪(⓪*dirEntryPtr := ptrDirEntry (entry);⓪*concatPath (path, dirEntryPtr^.entry.name, name, success);⓪*IF success THEN⓪,IF isSubdir (dirEntryPtr^.entry) THEN kindOfName := folderNK⓪,ELSE kindOfName := fileNK END;⓪*ELSE kindOfName := noNK END;⓪*⓪(ELSE (* mod. wdw *)⓪(⓪*modEntryPtr := ptrModEntry (entry);⓪*Assign (modEntryPtr^.name, name, voidO);⓪*kindOfName := modulNK;⓪*⓪(END;⓪&END;⓪&⓪$ELSE kindOfName := noNK END;⓪"END getSelectedName;⓪"⓪ PROCEDURE careOfDeselectEntries;⓪ ⓪"VAR slot : wdwSlotIdx;⓪(success: BOOLEAN;⓪ ⓪"BEGIN⓪$scanSlots (hasSelectedEntries, slot, success);⓪$IF success THEN deselectWList (wdws[slot]) END;⓪"END careOfDeselectEntries;⓪ ⓪ PROCEDURE closeTopWdw (complete: BOOLEAN);⓪ ⓪"VAR slot : wdwSlotIdx;⓪(success: BOOLEAN;⓪ ⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$scanSlots (isTopWdw, slot, success);⓪$IF success⓪$THEN⓪&WITH wdws[slot]^ DO CASE kind OF⓪&⓪(dirWdw : IF complete THEN path := '' END; (* forces closure *)⓪2closeDirWdw (wl, wdws[slot])|⓪(modWdw : closeModWdw (wl, wdws[slot])|⓪(⓪&END END;⓪$END;⓪$AESUpdateWindow (FALSE);⓪"END closeTopWdw;⓪ ⓪ PROCEDURE closeWdw (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$WITH wdws[slot]^ DO IF used THEN CASE kind OF⓪&⓪(dirWdw : path := ''; (* forces closure *)⓪2closeDirWdw (wl, wdws[slot])|⓪(modWdw : closeModWdw (wl, wdws[slot])|⓪(⓪$END END END;⓪$AESUpdateWindow (FALSE);⓪$RETURN FALSE⓪"END closeWdw;⓪ ⓪ PROCEDURE hideWdw (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$WITH wdws[slot]^ DO IF used THEN⓪$⓪&CASE kind OF⓪$⓪(dirWdw : deleteDirList (wdws[slot])|⓪(modWdw : deleteModList (wdws[slot])|⓪(⓪&END;⓪&HideWindowWL (wl);⓪&⓪$END END;⓪$RETURN FALSE⓪"END hideWdw;⓪"⓪ PROCEDURE setTopWdw (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"BEGIN⓪$IF wdws[slot]^.used AND wdws[slot]^.isTop THEN⓪&PutWindowOnTopWL (wdws[slot]^.wl);⓪$END;⓪$RETURN TRUE⓪"END setTopWdw;⓪"⓪ PROCEDURE showWdw (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"VAR success: BOOLEAN;⓪ ⓪"BEGIN⓪$WITH wdws[slot]^ DO IF used THEN⓪$⓪&CASE kind OF⓪&⓪(dirWdw : createDirList (wdws[slot], success)|⓪(modWdw : createModList (wdws[slot], success)|⓪(⓪&END;⓪&IF success THEN⓪(AESUpdateWindow (TRUE);⓪(ShowBee; ShowWindowWL (wl); ShowArrow;⓪(AESUpdateWindow (FALSE);⓪(IF StateWL (wl) = cantShowWL THEN⓪*ResetStateWL (wl);⓪*voidO := hideWdw (slot);⓪*used := FALSE;⓪(END;⓪&ELSE used := FALSE END;⓪&⓪$END END;⓪$RETURN FALSE⓪"END showWdw;⓪ ⓪ PROCEDURE updateModWdw (slot: wdwSlotIdx): BOOLEAN;⓪ ⓪"VAR slotPtr: ptrWdwSlot;⓪ ⓪"BEGIN⓪$slotPtr := wdws[slot];⓪$AESUpdateWindow (TRUE);⓪$IF slotPtr^.used AND (slotPtr^.kind = modWdw) THEN⓪&deleteModList (slotPtr);⓪&createModList (slotPtr, voidO);⓪$END;⓪$AESUpdateWindow (FALSE);⓪$⓪$RETURN FALSE⓪"END updateModWdw;⓪"⓪ PROCEDURE updateWdw (slotPtr: ptrWdwSlot);⓪ ⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$CASE slotPtr^.kind OF⓪&dirWdw : deleteDirList (slotPtr);⓪2createDirList (slotPtr, voidO)|⓪&modWdw : deleteModList (slotPtr);⓪2createModList (slotPtr, voidO)|⓪$END;⓪$AESUpdateWindow (FALSE);⓪"END updateWdw;⓪"⓪ ⓪ (* detectWdw -- tries to find a window at 'loc', if success then⓪!* 'contSearch = FALSE' and 'slotPtr' references⓪!* the slot of the window. If there is also an entry⓪!* beneath 'loc', then 'entry' is a reference to the⓪!* entry. In any other case 'entry = NIL'. 'clicks',⓪!* 'specials' and 'buts' are used to calc. the selection⓪!* mode. 'mode' says, if a selection has to be done.⓪!*)⓪!⓪ PROCEDURE detectWdws ( loc : Point;⓪:mode : DetectModeWL;⓪:clicks : CARDINAL;⓪:specials : SpecialKeySet;⓪:buts : MButtonSet;⓪6VAR entry : ADDRESS;⓪6VAR slotPtr : ptrWdwSlot;⓪6VAR contSearch: BOOLEAN);⓪(⓪"VAR wls : ARRAY wdwSlotIdx OF WindowList;⓪(wl : WindowList;⓪(slot : wdwSlotIdx;⓪(selMode : LONGCARD;⓪(env : ADDRESS;⓪ ⓪"BEGIN⓪$FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO⓪&wls[slot] := wdws[slot]^.wl⓪$END;⓪$IF clicks = 1 THEN⓪&IF withShift (specials) THEN selMode := multipleSelect⓪&ELSE selMode := onlyOneSelected END;⓪&IF msBut1 IN buts THEN selMode := selMode + pickUpSelect END;⓪$ELSE selMode := doubleClickSelect END;⓪$⓪$DetectWindowWL (wls,0, loc, mode, selMode, wl, entry, env, contSearch);⓪$⓪$IF wl = NoWindowList THEN entry := NIL END;⓪$slotPtr := ptrWdwSlot (env);⓪"END detectWdws;⓪ ⓪ ⓪ PROCEDURE SetGetWindows (f: File; mode: SetGetMode);⓪ ⓪"VAR slot : wdwSlotIdx;⓪"⓪(wdwParmCarrier: RECORD⓪(⓪:used, isTop : BOOLEAN;⓪:space : Rectangle;⓪:⓪:CASE kind: wdwKind⓪:OF⓪<dirWdw : path : Str128|⓪<modWdw : all : BOOLEAN|⓪:END;⓪:⓪8END;⓪ ⓪"BEGIN⓪$FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO WITH wdws[slot]^ DO⓪&IF mode = setValue THEN⓪&⓪(ReadBlock (f, wdwParmCarrier); IF State (f) < fOK THEN RETURN END;⓪(⓪(tmpSpace:= wdwParmCarrier.space;⓪(used := wdwParmCarrier.used;⓪(isTop := wdwParmCarrier.isTop;⓪(IF used THEN⓪*kind := wdwParmCarrier.kind;⓪*CASE kind OF⓪,dirWdw : path := wdwParmCarrier.path|⓪,modWdw : all := wdwParmCarrier.all|⓪*END;⓪(END;⓪(⓪&ELSE⓪&⓪(wdwParmCarrier.space := WindowSizeWL (wl);⓪(wdwParmCarrier.used := used;⓪(wdwParmCarrier.isTop := isTop;⓪(IF used THEN⓪*wdwParmCarrier.kind := kind;⓪*CASE kind OF⓪,dirWdw : wdwParmCarrier.path := path|⓪,modWdw : wdwParmCarrier.all := all|⓪*END;⓪(END;⓪(⓪(WriteBlock (f, wdwParmCarrier); IF State (f) < fOK THEN RETURN END;⓪(⓪&END;⓪$END END;⓪"END SetGetWindows;⓪"⓪"⓪8(* drag procs *)⓪8(* ========== *)⓪ ⓪ TYPE dragObjectKind = (fileDOK, filesDOK, modulDOK, modulsDOK);⓪(⓪(targetObjectKind= (objTOK, wdwTOK);⓪ ⓪(targetObject = RECORD⓪<CASE kind: targetObjectKind OF⓪<⓪>objTOK : obj : CARDINAL|⓪>⓪>(* 'valid = TRUE' means, that 'entry'⓪?* is a valid target.⓪?*)⓪>wdwTOK : slotPtr : ptrWdwSlot;⓪Hvalid : BOOLEAN;⓪Hentry : ADDRESS|⓪H⓪<END;⓪:END;⓪ ⓪ (* toggleTarget -- Toggle the target object, which is desribed by 'which'.⓪!* Don't toggle wdws without entry and the 'Root' object.⓪!*)⓪ ⓪ PROCEDURE toggleTarget (which: targetObject; selected: BOOLEAN);⓪ ⓪"VAR found: BOOLEAN;⓪"⓪"BEGIN⓪$WITH which DO CASE kind OF⓪&objTOK : IF obj # Root THEN toggleDeskObj (obj, voidO) END|⓪&wdwTOK : IF valid THEN⓪2entrySelected (slotPtr, entry, selected)⓪0END|⓪$END END;⓪"END toggleTarget;⓪ ⓪ TYPE selObj = RECORD⓪<loc : Point;⓪<boxes: List;⓪:END;⓪(ptrSelObj = POINTER TO selObj;⓪ ⓪ PROCEDURE toggleSelectedBox (entry, env: ADDRESS): BOOLEAN;⓪ ⓪"VAR selObjPtr : ptrSelObj;⓪(data : ptrRectangle;⓪(⓪(pts : ARRAY[0..4] OF Point;⓪(x, y, w, h: INTEGER;⓪"⓪"BEGIN⓪$selObjPtr := ptrSelObj (env);⓪$data := ptrRectangle (entry);⓪$⓪$x := selObjPtr^.loc.x + data^.x; x := x - x MOD 2;⓪$y := selObjPtr^.loc.y + data^.y; y := y - y MOD 2;⓪$w := data^.w - data^.w MOD 2;⓪$h := data^.h - data^.h MOD 2;⓪$pts[0].x := x;⓪$pts[0].y := y;⓪$pts[1].x := x + w;⓪$pts[1].y := y;⓪$pts[2].x := x + w;⓪$pts[2].y := y + h;⓪$pts[3].x := x;⓪$pts[3].y := y + h;⓪$pts[4].x := x;⓪$pts[4].y := y;⓪$PolyLine (dev, pts, 0);⓪$⓪$RETURN TRUE⓪"END toggleSelectedBox;⓪"⓪ PROCEDURE dragSensitive ( objFrame: Rectangle;⓪=object : ADDRESS;⓪=objKind : dragObjectKind;⓪9VAR loc : Point;⓪9VAR result : targetObject);⓪"⓪"(* scanTarget -- Scans at 'loc' for icons, wdws, etc. Looks only at objects⓪#* that are interesting for 'objKind'.⓪#* If a wdw entry is not interesting 'result.valid = FALSE'⓪#* and if an icon is not interesting 'result.obj = Root'.⓪#*⓪#* This proc.s logic depends strongly on the semantic of the shells objs.⓪#*)⓪ ⓪"PROCEDURE scanTarget ( loc : Point;⓪<objKind : dragObjectKind;⓪<oldResult: targetObject;⓪8VAR result : targetObject);⓪ ⓪$VAR contSearch,⓪(isModul,⓪(onlyOne,⓪(foundDrive,⓪(foundWorkfile: BOOLEAN;⓪(d : Drive;⓪(i : CARDINAL;⓪(dirEntryPtr : ptrDirEntry;⓪"⓪$BEGIN⓪&isModul := (objKind = modulDOK) OR (objKind = modulsDOK);⓪&onlyOne := (objKind = modulDOK) OR (objKind = fileDOK);⓪&WITH result DO⓪&⓪(kind := wdwTOK;⓪(detectWdws (loc, scanWL, 0, SpecialKeySet {}, MButtonSet {}, entry,⓪4slotPtr, contSearch);⓪(⓪(IF ~ contSearch THEN⓪(⓪*(* 'valid = TRUE' is only allowed, if entry is a subdirectory⓪+* and there are files moved and subdir. is not selected yet,⓪+* or if it is same entry as the last entry (within 'oldResult').⓪+*)⓪*IF slotPtr^.kind = dirWdw THEN⓪,dirEntryPtr := ptrDirEntry (entry);⓪,valid := NOT ((entry = NIL) OR ~ isSubdir (dirEntryPtr^.entry)⓪:OR isModul⓪:OR ((selectedWL IN EntryAttributesWL (slotPtr^.wl,⓪_entry))⓪>AND ((entry # oldResult.entry)⓪COR NOT oldResult.valid⓪COR (oldResult.kind # wdwTOK))⓪9) );⓪*ELSE valid := FALSE; entry := NIL END;⓪*⓪(ELSE⓪(⓪*kind := objTOK;⓪*obj := FindObject (desk, Root, MaxDepth, loc);⓪*searchDrive (obj, d, foundDrive);⓪*searchWorkfile (obj, i, foundWorkfile);⓪*IF (obj # Trash) AND⓪-(~ onlyOne OR (obj # Execute)) AND⓪-(isModul OR ~ foundDrive) AND⓪-((objKind # fileDOK) OR⓪.((obj # Edit) AND (obj # Compile) AND (obj # Link) AND⓪/(obj # Scan) AND (obj # Resident) AND (obj # Cfname) AND⓪/~ foundWorkfile⓪.)⓪-) THEN obj := Root END;⓪(END;⓪*⓪&END;⓪$END scanTarget;⓪"⓪"PROCEDURE toggleObj (loc: Point; object: ADDRESS);⓪"⓪$VAR selObjPtr: ptrSelObj;⓪"⓪$BEGIN⓪&selObjPtr := ptrSelObj (object);⓪&⓪&SetClipping (dev, deskSize);⓪&SetLineColor (dev, black);⓪&SetWritingMode (dev, xorWrt);⓪&SetLineType (dev, userLn);⓪&DefUserLine (dev, $5555);⓪&⓪&HideMouse;⓪&selObjPtr^.loc := loc;⓪&applyAtList (selObjPtr^.boxes, toggleSelectedBox, object, voidO);⓪&ShowMouse;⓪&⓪$END toggleObj;⓪$⓪"PROCEDURE notSame (trgObj1, trgObj2: targetObject): BOOLEAN;⓪"⓪$VAR res: BOOLEAN;⓪"⓪$BEGIN⓪&res := (trgObj1.kind # trgObj2.kind);⓪&IF ~ res THEN⓪(IF trgObj1.kind = objTOK THEN res := (trgObj1.obj # trgObj2.obj)⓪(ELSE res := (trgObj1.slotPtr # trgObj2.slotPtr) OR⓪4(trgObj1.entry # trgObj2.entry)⓪(END;⓪&END;⓪&RETURN res⓪$END notSame;⓪$⓪$⓪"VAR buts : MButtonSet;⓪(specials : SpecialKeySet;⓪(⓪(oldLoc : Point;⓪(oldResult: targetObject;⓪(⓪(deskSize : Rectangle;⓪"⓪"BEGIN⓪$MouseControl (TRUE);⓪$⓪$deskSize := DeskSize ();⓪$MouseKeyState (oldLoc, buts, specials);⓪$oldLoc := loc;⓪$oldResult.kind := objTOK;⓪$oldResult.obj := Root;⓪$⓪$toggleObj (MinPoint (objFrame), object);⓪$⓪$WHILE msBut1 IN buts DO⓪$⓪&IF (loc.x # oldLoc.x) OR (loc.y # oldLoc.y) THEN⓪"⓪(toggleObj (MinPoint (objFrame), object);⓪(⓪(objFrame.x := objFrame.x - oldLoc.x + loc.x;⓪(objFrame.y := objFrame.y - oldLoc.y + loc.y;⓪"⓪(WITH objFrame DO (* Rahmen innerhalb Desk! *)⓪*IF x < deskSize.x THEN x := deskSize.x END;⓪*IF y < deskSize.y THEN y := deskSize.y END;⓪*IF (x + w) > (deskSize.x + deskSize.w) THEN⓪,x := deskSize.x + deskSize.w - w END;⓪*IF (y + h) > (deskSize.y + deskSize.h) THEN⓪,y := deskSize.y + deskSize.h - h END;⓪(END;⓪(⓪(scanTarget (loc, objKind, oldResult, result);⓪(⓪(IF notSame (result, oldResult) THEN⓪*toggleTarget (oldResult, FALSE);⓪*toggleTarget (result, TRUE);⓪*oldResult := result;⓪(END;⓪$⓪(toggleObj (MinPoint (objFrame), object);⓪(oldLoc := loc;⓪(⓪&END;(*IF*)⓪"⓪&MouseKeyState (loc, buts, specials);⓪"⓪$END;(*WHILE*)⓪$⓪$toggleObj (MinPoint (objFrame), object);⓪$⓪$MouseControl (FALSE);⓪"END dragSensitive;⓪ ⓪ ⓪ TYPE (* Environment record for 'frameSelectedBox' and 'buildObject'.⓪)*)⓪(fBEnvRec = RECORD⓪<wl : WindowList;⓪<frame : Rectangle;⓪<selObj: ptrSelObj;⓪:END;⓪(ptrFBEnv = POINTER TO fBEnvRec;⓪ ⓪ (*$Z-*)⓪ PROCEDURE frameSelectedBox (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"VAR framerEnv: ptrFBEnv;⓪(box : Rectangle;⓪ ⓪"BEGIN⓪$IF selectedWL IN attrs THEN⓪$⓪&framerEnv := ptrFBEnv (env);⓪&⓪&GetEntryBoxWL (framerEnv^.wl, entry, box, voidO);⓪&box.w := box.w DIV INTEGER (dirWdwWidth) * INTEGER (dirVisibleWidth);⓪&IF framerEnv^.frame.h = 0 THEN framerEnv^.frame := box⓪&ELSE⓪(framerEnv^.frame := FrameRects (framerEnv^.frame, box)⓪&END;⓪&⓪$END;⓪$⓪$RETURN TRUE⓪"END frameSelectedBox;⓪ ⓪ (*$Z-*)⓪ PROCEDURE buildObject (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"VAR builderEnv: ptrFBEnv;⓪(box : Rectangle;⓪(data : ptrRectangle;⓪(err : BOOLEAN;⓪(⓪"BEGIN⓪$builderEnv := ptrFBEnv (env);⓪$⓪$IF selectedWL IN attrs THEN WITH builderEnv^ DO⓪$⓪&GetEntryBoxWL (wl, entry, box, voidO);⓪&⓪&NEW (data);⓪&IF data = NIL THEN RETURN FALSE END;⓪&WITH box DO⓪(data^ := Rect (x - selObj^.loc.x, y - selObj^.loc.y,⓪7w DIV INTEGER (dirWdwWidth) * INTEGER (dirVisibleWidth),⓪7h);⓪&END;⓪&AppendEntry (selObj^.boxes, data, err);⓪&IF err THEN DISPOSE (data); RETURN FALSE END;⓪&⓪$END END;⓪&⓪$RETURN TRUE⓪"END buildObject;⓪"⓪ PROCEDURE moveFileModul ( slotPtr: ptrWdwSlot;⓪=which : dragObjectKind;⓪=loc : Point;⓪9VAR result : targetObject;⓪9VAR success: BOOLEAN);⓪9⓪"VAR fBEnv : fBEnvRec;⓪(⓪(err : BOOLEAN;⓪"⓪"BEGIN⓪$WITH slotPtr^ DO IF noSelected > 0 THEN⓪$⓪&fBEnv.wl := wl;⓪&fBEnv.frame.h := 0;⓪&QueryListWL (wl, forwardWL, frameSelectedBox, ADR (fBEnv),⓪3voidO, voidADR);⓪&⓪&NEW (fBEnv.selObj); success := (fBEnv.selObj # NIL);⓪&IF success THEN⓪(CreateList (fBEnv.selObj^.boxes, err); success := ~ err;⓪(IF NOT success THEN DISPOSE (fBEnv.selObj) END;⓪&END;⓪&IF err THEN reportOutOfMemory; RETURN END;⓪&fBEnv.selObj^.loc := MinPoint (fBEnv.frame);⓪&QueryListWL (wl, forwardWL, buildObject, ADR (fBEnv), voidO, voidADR);⓪&⓪&dragSensitive (fBEnv.frame, fBEnv.selObj, which, loc, result);⓪&⓪&deleteSimpleList (fBEnv.selObj^.boxes, TRUE);⓪&DISPOSE (fBEnv.selObj);⓪&⓪$END END;⓪"END moveFileModul;⓪"⓪ ⓪8(* misc. II *)⓪8(* ======== *)⓪ ⓪ PROCEDURE enableAndDisableMenuItems;⓪ ⓪"VAR slot : wdwSlotIdx;⓪(aDirWdwIsOpen,⓪(aModWdwIsOpen,⓪(aTopWdw,⓪(bothOpen : BOOLEAN;⓪(kindOfName : nameKind;⓪ ⓪"BEGIN⓪$scanSlots (isDirWdw, slot, aDirWdwIsOpen);⓪$scanSlots (isModWdw, slot, aModWdwIsOpen);⓪$scanSlots (isTopWdw, slot, aTopWdw);⓪$⓪$bothOpen := (aDirWdwIsOpen OR aModWdwIsOpen);⓪$⓪$EnableItem (menu,Mdclose, bothOpen);⓪$EnableItem (menu,Mdclosew, bothOpen);⓪$EnableItem (menu,Mdfolder, aTopWdw AND (wdws[slot]^.kind = dirWdw));⓪$⓪$getSelectedName (void128, voidSlot, kindOfName);⓪$⓪$EnableItem (menu,Mdinfo, (kindOfName = fileNK)⓪=OR (kindOfName = folderNK)⓪=OR (selectedDrive # defaultDrv));⓪$⓪$EnableItem (menu,Mdnwork, WorkField.noUsed < maxWorkFiles);⓪$EnableItem (menu,Mdkwork, WorkField.current # noCurrentWorkfile);⓪"END enableAndDisableMenuItems;⓪ ⓪0(* Arbeitende Routinen *)⓪0(* =================== *)⓪ ⓪ FORWARD HideSS (complete: BOOLEAN);⓪ FORWARD ShowSS (isCompleteHidden: BOOLEAN);⓪ ⓪ (* selectWorkfile -- Selects another work file object. Only used slots would⓪!* be selected.⓪!*)⓪!⓪ PROCEDURE selectWorkfile (i: INTEGER);⓪ ⓪"VAR old: INTEGER;⓪ ⓪"BEGIN⓪$IF ~ WorkField.elems[i].used THEN i := noCurrentWorkfile END;⓪$old := WorkField.current;⓪$WorkField.current := i;⓪$IF old >= 0 THEN redrawWorkfile (old) END;⓪$IF i >= 0 THEN redrawWorkfile (i) END;⓪"END selectWorkfile;⓪ ⓪ (* makeNewWorkfile -- Tries to make another work file object.⓪!*)⓪!⓪ PROCEDURE makeNewWorkfile;⓪ ⓪"VAR i : CARDINAL;⓪(⓪"BEGIN⓪$animateMenuTitle (Mdatei, voidFrame);⓪$⓪$(* find free slot.⓪%*)⓪$(* wir wollen mit Nr. 1 anfangen, erst nach Nr. 9 soll Nr. 0 kommen *)⓪$i := 1;⓪$WHILE (i <= maxWorkFiles) AND WorkField.elems[i MOD 10].used DO INC (i) END;⓪$IF i = 10 THEN i:= 0 END;⓪$⓪$IF i < maxWorkFiles THEN (* if found, then init. slot *)⓪$⓪&INC (WorkField.noUsed);⓪&WITH WorkField.elems[i] DO⓪(used := TRUE;⓪(sourceName := '';⓪(codeName := '';⓪&END;⓪&selectWorkfile (i);⓪&⓪$ELSE⓪&doAlert (noNewWorkAlt)⓪$END;⓪$⓪$deAnimateMenuTitle (Mdatei);⓪"END makeNewWorkfile;⓪ ⓪ (* killWorkfile -- Releases the current workfile object.⓪!*)⓪ ⓪ PROCEDURE killWorkfile;⓪ ⓪"BEGIN⓪$animateMenuTitle (Mdatei, voidFrame);⓪$⓪$WITH WorkField DO⓪&IF current # noCurrentWorkfile THEN⓪&⓪(DEC (noUsed);⓪(elems[current].used := FALSE;⓪(redrawWorkfile (current);⓪(current := noCurrentWorkfile;⓪(⓪&END;⓪$END;⓪&⓪$deAnimateMenuTitle (Mdatei);⓪"END killWorkfile;⓪#⓪ PROCEDURE saveParameter;⓪ ⓪"VAR but: CARDINAL;⓪ ⓪"BEGIN⓪$FormAlert (1, parmSaveAlt^, but);⓪$IF but = 1 THEN SaveParameter END;⓪"END saveParameter;⓪ ⓪ PROCEDURE makeFolder;⓪ ⓪"VAR ok,⓪(success: BOOLEAN;⓪(name : Str128;⓪(slot : wdwSlotIdx;⓪(result : INTEGER;⓪ ⓪"BEGIN⓪$IF ObjectStateElem (menu, Mdfolder, disableObj) THEN RETURN END;⓪$⓪$AESUpdateWindow (TRUE);⓪$name := '';⓪$doFNameBox (requestFolderName, name, ok);⓪$IF ok THEN⓪$⓪&scanSlots (isTopWdw, slot, success);⓪&IF ~ success THEN⓪(AESUpdateWindow (FALSE);⓪(RETURN⓪&END;⓪&concatPath (wdws[slot]^.path, name, name, success);⓪&IF ~ success THEN AESUpdateWindow (FALSE); RETURN END;⓪&⓪&ShowBee;⓪&CreateDir (name, result); FileAlert (result);⓪&ShowArrow;⓪&⓪&updateWdw (wdws[slot]);⓪&⓪$END;⓪$AESUpdateWindow (FALSE);⓪"END makeFolder;⓪ ⓪ PROCEDURE inform;⓪ ⓪"VAR spc : LONGCARD;⓪(slot : wdwSlotIdx;⓪(name : Str128;⓪(kindOfName : nameKind;⓪ ⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$IF selectedDrive # defaultDrv THEN (* drive info *)⓪&ShowBee; spc := FreeSpace (MOSGlobals.Drive(selectedDrive)); ShowArrow;⓪&flexAlert (1, DriveToStr (MOSGlobals.Drive(selectedDrive)),⓪(CardToStr (spc, 0), drvSpaceMsg, voidC);⓪$ELSE⓪&getSelectedName (name, slot, kindOfName);⓪&IF (kindOfName=fileNK) OR (kindOfName=folderNK) THEN (* file info *)⓪(FileInformation (name, doFileInfoBox, FileAlert);⓪(updateWdw (wdws[slot]);⓪&END;⓪$END;⓪$AESUpdateWindow (FALSE);⓪"END inform;⓪ ⓪ (*$Z-*)⓪ PROCEDURE addEntryToList (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"VAR dirEntryPtr: ptrDirEntry;⓪(listPtr : ptrList;⓪(err : BOOLEAN;⓪ ⓪"BEGIN⓪$dirEntryPtr := ptrDirEntry (entry);⓪$listPtr := ptrList (env);⓪$⓪$IF selectedWL IN attrs⓪$THEN⓪&AppendEntry (listPtr^, ADR (dirEntryPtr^.entry.name), err)⓪$ELSE err := FALSE END;⓪$⓪$RETURN ~ err⓪"END addEntryToList;⓪ ⓪ PROCEDURE showCopyStatus (noFiles: CARDINAL; VAR stop: BOOLEAN);⓪ ⓪"VAR ch : GemChar;⓪(valid: BOOLEAN;⓪ ⓪"BEGIN⓪$IF shellParm.confirmCopy THEN⓪&SetGetBoxCard (confirmBox, Conumber, setValue, noFiles);⓪&drawObject (confirmBox, Conumber);⓪$END;⓪$⓪$busyReadGemChar (ch, valid);⓪$stop := valid AND (ch.scan = undoKey);⓪"END showCopyStatus;⓪"⓪ PROCEDURE showDeleteStatus (noFiles: CARDINAL; VAR stop: BOOLEAN);⓪ ⓪"VAR ch : GemChar;⓪(valid: BOOLEAN;⓪ ⓪"BEGIN⓪$IF shellParm.confirmDelete THEN⓪&SetGetBoxCard (confirmBox, Conumber, setValue, noFiles);⓪&drawObject (confirmBox, Conumber);⓪$END;⓪$⓪$busyReadGemChar (ch, valid);⓪$stop := valid AND (ch.scan = undoKey);⓪"END showDeleteStatus;⓪"⓪ TYPE copyDeleteMode = (copyCDM, deleteCDM);⓪ ⓪ PROCEDURE prepareCopyAndDelete ( slotPtr: ptrWdwSlot;⓪Dmode : copyDeleteMode;⓪@VAR files : List;⓪@VAR noFiles: CARDINAL;⓪@VAR space : Rectangle;⓪@VAR ok : BOOLEAN;⓪@VAR err : BOOLEAN);⓪ ⓪"VAR exitBut: CARDINAL;⓪ ⓪"BEGIN⓪$WITH slotPtr^ DO⓪&CreateList (files, err);⓪&IF err THEN reportOutOfMemory; RETURN END;⓪&QueryListWL (wl, forwardWL, addEntryToList, ADR (files), err, voidADR);⓪&IF err THEN deleteList (files); reportOutOfMemory; RETURN END;⓪&⓪&IF ((mode = copyCDM) AND shellParm.confirmCopy)⓪)OR ((mode = deleteCDM) AND shellParm.confirmDelete) THEN⓪)⓪(ShowBee;⓪(CountFilesAndDirs (path, files, noFiles);⓪(⓪(SetCurrObjTree (confirmBox, FALSE);⓪(hideObj (Cocopy, mode = deleteCDM); hideObj (Codelete, mode = copyCDM);⓪(hideObj (Cook, FALSE); hideObj (Coquit, FALSE);⓪(hideObj (Cowork, TRUE);⓪(SetGetBoxCard (confirmBox, Conumber, setValue, noFiles);⓪(⓪(PrepareBox (confirmBox, Rect (-1, -1, -1, -1), space);⓪(formDo (confirmBox, Root, exitBut);⓪(DeselectButton (confirmBox, exitBut);⓪(ok := (exitBut = Cook);⓪(⓪(IF ok THEN⓪*SetCurrObjTree (confirmBox, FALSE);⓪*hideAndRedrawObj (Cook, TRUE); hideAndRedrawObj (Coquit, TRUE);⓪*hideAndRedrawObj (Cowork, FALSE);⓪(END;⓪&⓪&ELSE noFiles := 0; ok := TRUE END;⓪$END;⓪$ShowBee;⓪"END prepareCopyAndDelete;⓪ ⓪ PROCEDURE copyFiles (slotPtr : ptrWdwSlot;⓪5REF destPath : ARRAY OF CHAR;⓪5deleteOld: BOOLEAN);⓪ ⓪"VAR files : List;⓪(noFiles: CARDINAL;⓪(ok, err: BOOLEAN;⓪(space : Rectangle;⓪ ⓪"BEGIN⓪$prepareCopyAndDelete (slotPtr, copyCDM, files, noFiles, space, ok, err);⓪$IF err THEN RETURN END;⓪$IF ok THEN⓪&CopyFiles (slotPtr^.path, files, noFiles, destPath,⓪1deleteOld, shellParm.useAllMemForCopy,⓪1doConflictBox, showCopyStatus, FileAlert);⓪$END;⓪$IF shellParm.confirmCopy THEN⓪&ReleaseBox (confirmBox, Rect (-1, -1, -1, -1), space)⓪$END;⓪$deleteList (files);⓪$ShowArrow;⓪"END copyFiles;⓪ ⓪ PROCEDURE deleteFiles (slotPtr: ptrWdwSlot);⓪ ⓪"VAR files : List;⓪(noFiles: CARDINAL;⓪(ok, err: BOOLEAN;⓪(space : Rectangle;⓪ ⓪"BEGIN⓪$prepareCopyAndDelete (slotPtr, deleteCDM, files, noFiles, space, ok, err);⓪$IF err THEN RETURN END;⓪$IF ok THEN⓪&DeleteFiles (slotPtr^.path, files, noFiles, showDeleteStatus, FileAlert);⓪$END;⓪$IF shellParm.confirmDelete THEN⓪&ReleaseBox (confirmBox, Rect (-1, -1, -1, -1), space)⓪$END;⓪$deleteList (files);⓪$ShowArrow;⓪"END deleteFiles;⓪ ⓪ (* actManager -- Prepares the shell to execute a shell action and then calls⓪!* the 'action' procedure in the outer module.⓪!*⓪!* 'obj' -- Desktop object associated with the desired⓪!* action.⓪!* 'specials' -- Special keys pressed at action selection time.⓪!* 'work' -- Parameter of the action is a work file?⓪!* 'tool' -- Is a executed file a tool? (to set the correct⓪!* path in 'call')⓪!* 'alsoExec' -- Also excecute code after compilation?⓪!*)⓪"⓪ PROCEDURE actManager (obj : CARDINAL;⓪6specials: SpecialKeySet;⓪6work,⓪6tool,⓪6alsoExec: BOOLEAN);⓪ ⓪"PROCEDURE assignMsg (REF name: ARRAY OF CHAR);⓪$BEGIN⓪&truncCopyString (name, msgStrLen, msgStr);⓪$END assignMsg;⓪ ⓪"PROCEDURE setSourceCurrFnAndMsg;⓪$BEGIN⓪&IF ~work AND (currFn[0]='') THEN⓪(currFn := lastFn;⓪&END;⓪&IF work THEN⓪(WITH WorkField DO⓪*IF current >= 0 THEN assignMsg (elems[current].sourceName)⓪*ELSE msgStr := '' END;⓪(END;⓪&ELSE assignMsg (currFn) END;⓪$END setSourceCurrFnAndMsg;⓪$⓪"PROCEDURE setCodeCurrFnAndMsg;⓪$BEGIN⓪&IF ~work AND (currFn[0]='') THEN⓪(currFn := CodeName;⓪&END;⓪&IF work THEN⓪(WITH WorkField DO⓪*IF current # noCurrentWorkfile THEN⓪,assignMsg (elems[current].codeName)⓪*ELSE msgStr := '' END;⓪(END;⓪&ELSE assignMsg (currFn) END;⓪$END setCodeCurrFnAndMsg;⓪"⓪"TYPE testProc = PROCEDURE (REF (* name: *) ARRAY OF CHAR): BOOLEAN;⓪$⓪"PROCEDURE testWorkAndCurrFn ((*$Z-*)test: testProc(*$Z=*)): BOOLEAN;⓪$BEGIN⓪&WITH WorkField DO⓪(IF work AND (current = noCurrentWorkfile) THEN RETURN FALSE⓪(ELSE⓪*RETURN (work AND test (elems[current].sourceName)) OR test (currFn)⓪(END;⓪&END;⓪$END testWorkAndCurrFn;⓪$⓪"VAR slot : wdwSlotIdx;⓪&wasSelected: BOOLEAN;⓪ ⓪"BEGIN⓪$selectDeskObj (obj, TRUE, wasSelected);⓪$CASE obj OF⓪&Compile : setSourceCurrFnAndMsg;⓪1IF testWorkAndCurrFn (isMakeFile) THEN⓪3IF alsoExec THEN action (doMkEx, work, tool)⓪3ELSE action (doMake, work, tool) END;⓪1ELSE⓪3IF alsoExec THEN action (doCpEx, work, tool)⓪3ELSE action (doComp, work, tool) END;⓪1END|⓪&Edit : setSourceCurrFnAndMsg; action (doEdit, work, tool)|⓪&Execute : setCodeCurrFnAndMsg;⓪1Assign (lastFn, TextName, voidO);⓪1IF ~ work AND IsSourceName (currFn) THEN⓪3assignMsg (currFn);⓪3action (doExec, work, tool);⓪1ELSE⓪3IF testWorkAndCurrFn (IsMBTFile) (* exec. Batch-File *) THEN⓪5action (doBtch, work, tool);⓪3ELSIF testWorkAndCurrFn (isMSPFile) (* exec. Parm.-File *) THEN⓪5action (doParm, work, tool);⓪3ELSIF testWorkAndCurrFn (isMakeFile)(* exec. Make-File *) THEN⓪5action (doMkEx, work, tool);⓪3ELSE (* exec. norm. code *)⓪5IF withShift (specials) THEN⓪7RequestArg (lastArgs);⓪7args := lastArgs;⓪5ELSE⓪7args := '';⓪5END;⓪5noDirChange := withAlt (specials);⓪5action (doExec, work, tool);⓪5noDirChange := FALSE;⓪3END;⓪1END;⓪1Assign (TextName, lastFn, voidO)|⓪&Link : setCodeCurrFnAndMsg; action (doLink, work, tool)|⓪&⓪&Scan : setSourceCurrFnAndMsg;⓪1IF (ChainDepth < 0) OR ~ withShift (specials) THEN⓪3IF doScanBox () THEN⓪5action (doScan, work, tool);⓪3END;⓪1ELSE msgStr := ''; action (doCont, TRUE, tool) END|⓪1⓪&Resident : setCodeCurrFnAndMsg;⓪1IF work THEN⓪3openModWdw (slot, withAlt (specials))⓪1ELSE⓪3AESUpdateWindow (TRUE);⓪3HideSS (FALSE);⓪3TellLoading (initTell, '');⓪3action (doLoad, FALSE, tool);⓪3TellLoading (endTell, '');⓪3ShowSS (FALSE);⓪3scanSlots (updateModWdw, voidSlot, voidO);⓪3AESUpdateWindow (FALSE);⓪1END|⓪$ELSE⓪$END;⓪$IF ~ wasSelected THEN selectDeskObj (obj, FALSE, voidO) END;⓪"END actManager;⓪9⓪ PROCEDURE executeTool (i: CARDINAL; specials: SpecialKeySet);⓪ ⓪"VAR code: FileStr;⓪ ⓪"BEGIN⓪$IF ToolField[i].used AND NOT Empty (ToolField[i].name) THEN⓪&currFn := ToolField[i].name;⓪&code := CodeName; (* Akt. Code-Datei retten *)⓪&actManager (Execute, specials, FALSE, TRUE, FALSE);⓪&CodeName := code; (* Akt. Code-Datei wiederherstellen *)⓪$END;⓪"END executeTool;⓪ ⓪ PROCEDURE editDocu (specials: SpecialKeySet);⓪ ⓪"VAR oldText, oldLast: FileStr;⓪"⓪"BEGIN⓪$animateMenuTitle (Minfo, voidFrame);⓪$⓪$ConcatName (shellParm.parameterPath, suf[m2d], currFn);⓪$oldText := TextName;⓪$oldLast := lastFn;⓪$actManager (Edit, specials, FALSE, FALSE, FALSE);⓪$TextName := oldText;⓪$lastFn := oldLast;⓪$⓪$deAnimateMenuTitle (Minfo);⓪"END editDocu;⓪"⓪ ⓪ CONST maxObjsElem = 1023;⓪ ⓪ TYPE loadAndUnloadMode = (loadModuls, unloadModuls);⓪(loadAndUnloadEnv = RECORD⓪(⓪Dmode: loadAndUnloadMode;⓪D⓪D(* Storage area for the obj. names.⓪E* Seperated through '0C's. 'free'⓪E* points to the next free elem.⓪E*)⓪Dobjs: ARRAY[0..maxObjsElem] OF CHAR;⓪Dfree: CARDINAL;⓪D⓪BEND;⓪(ptrLoadAndUnloadEnv = POINTER TO loadAndUnloadEnv;⓪ ⓪ (*$Z-*)⓪ PROCEDURE loadAndUnloadOneModul ( entry,⓪Eenv : ADDRESS;⓪AVAR attrs : AttributesWL): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"VAR envPtr : ptrLoadAndUnloadEnv;⓪(dirEntryPtr : ptrDirEntry;⓪(modEntryPtr : ptrModEntry;⓪(l, i : CARDINAL;⓪ ⓪"BEGIN⓪$envPtr := ptrLoadAndUnloadEnv (env);⓪$⓪$IF selectedWL IN attrs⓪$THEN⓪&WITH envPtr^ DO⓪&⓪(IF mode = loadModuls THEN (* laden *)⓪&⓪*dirEntryPtr := ptrDirEntry (entry);⓪*l := Length (dirEntryPtr^.entry.name);⓪*IF (l + free) > maxObjsElem THEN RETURN FALSE END;⓪*FOR i := 0 TO l - 1 DO⓪,objs[free] := dirEntryPtr^.entry.name[i];⓪,INC (free);⓪*END;⓪*objs[free] := 0C;⓪*INC (free);⓪*(*Insert (dirEntryPtr^.entry.name, free, objs); is wohl put*)⓪*⓪(ELSE (* löschen *)⓪(⓪*modEntryPtr := ptrModEntry (entry);⓪*l := Length (modEntryPtr^.name);⓪*IF (l + free) > maxObjsElem THEN RETURN FALSE END;⓪*FOR i := 0 TO l - 1 DO⓪,objs[free] := modEntryPtr^.name[i];⓪,INC (free);⓪*END;⓪*objs[free] := 0C;⓪*INC (free);⓪*(*Insert (modEntryPtr^.name, free, objs); is wohl put*)⓪*⓪(END;⓪((*INC (free, l + 1); (* '0C' nicht vergessen *)*)⓪(⓪&END;⓪$END;⓪$⓪$RETURN TRUE⓪"END loadAndUnloadOneModul;⓪ ⓪ PROCEDURE loadAndUnload (slotPtr: ptrWdwSlot; mode: loadAndUnloadMode);⓪ ⓪"VAR env : loadAndUnloadEnv;⓪(str : ARRAY[0..79] OF CHAR;⓪(i, j : CARDINAL;⓪(err,⓪(success : BOOLEAN;⓪ ⓪"BEGIN⓪$env.mode := mode;⓪$env.free := 0;⓪$QueryListWL (slotPtr^.wl, forwardWL, loadAndUnloadOneModul, ADR (env),⓪1err, voidADR);⓪$IF err THEN doAlert (loadFailedAlt); RETURN END;⓪$⓪$AESUpdateWindow (TRUE);⓪$HideSS (FALSE);⓪$IF mode = loadModuls THEN TellLoading (initTell, '') END;⓪$⓪$i := 0;⓪$j := 0;⓪$WHILE j < env.free DO⓪&str[i] := env.objs[j];⓪&INC (i);⓪&IF env.objs[j] = 0C THEN⓪(IF mode = loadModuls THEN⓪*TellLoading (newTellValue, str);⓪*concatPath (slotPtr^.path, str, currFn, success);⓪*IF success THEN action (doLoad, FALSE, FALSE) END;⓪(ELSE⓪*Assign (str, currFn, voidO);⓪*action (doUnLd, FALSE, FALSE);⓪(END;(*ELSE*)⓪(i := 0;⓪&END;(*IF*)⓪&INC (j);⓪$END;(*WHILE*)⓪$IF mode = loadModuls THEN TellLoading (endTell, '') END;⓪&⓪$ShowSS (FALSE);⓪$scanSlots (updateModWdw, voidSlot, voidO); (* mod. wdws updaten *)⓪$AESUpdateWindow (FALSE);⓪"END loadAndUnload;⓪!⓪ ⓪0(* Routinen zur De-/Aktivierung der ShellShell *)⓪0(* =========================================== *)⓪"⓪ PROCEDURE ClearDeskAndShowMsg;⓪ ⓪"BEGIN⓪$MenuBar (NIL, FALSE);⓪$SetNewDesk (NIL, Root);⓪$ForceDeskRedraw;⓪$IF NOT multiGEM & NOT multiTOS THEN⓪&(* MS unter MultiGEM nichts in Menüleise zeichnen *)⓪&DrawObject (msgBar, Root, MaxDepth, ObjectSpaceWithAttrs (msgBar, Root));⓪$END;⓪"END ClearDeskAndShowMsg;⓪ ⓪ PROCEDURE ShowSS (isCompleteHidden: BOOLEAN);⓪ ⓪"VAR i : INTEGER;⓪(name: NameStr;⓪ ⓪"BEGIN⓪$IF isCompleteHidden THEN⓪$⓪&SetCurrGemHandle (gemHdl, ok);⓪&IF ~ ok THEN (* Shell muß hier terminieren ! *) HALT END;⓪&⓪&setTools;⓪&FOR i := 0 TO maxWorkFiles - 1 DO WITH WorkField.elems[i] DO⓪(SplitPath (sourceName, void128, name);⓪(SetTextString (desk, nameIdx, name);⓪(SetObjStateElem (desk, identIdx, selectObj,⓪9WorkField.current = INTEGER (i));⓪(hideObj (carrierIdx, ~ used);⓪&END END;⓪&⓪&MouseInput (TRUE);⓪&ShowArrow;⓪&SetNewDesk (desk, Root);⓪&ForceDeskRedraw;⓪&MenuBar (menu, TRUE);⓪$END;⓪$⓪$scanSlots (showWdw, voidSlot, voidO);⓪$scanSlots (setTopWdw, voidSlot, voidO);⓪"END ShowSS;⓪"⓪ ⓪ (* InitWorkfile -- Set hide-flag of the object carrier and find out the⓪!* object indices.⓪!* The box-char is completely covered from an i-box, that⓪!* is the box-char's only child!⓪!*)⓪!⓪ PROCEDURE InitWorkfile (workfileNumber, crrIdx: CARDINAL);⓪ ⓪"VAR head, tail: CARDINAL;⓪&space : Rectangle;⓪ ⓪"BEGIN⓪$hideObj (crrIdx, TRUE);⓪$ensureVisibility (crrIdx);⓪$WITH WorkField.elems[workfileNumber] DO⓪$⓪&carrierIdx := crrIdx;⓪&⓪&GetObjRelatives (carrierIdx, voidC, head, tail);⓪&LOOP⓪&⓪(IF ObjectType (head) = boxCharObj THEN⓪*GetObjRelatives (head, voidC, identIdx, voidC)⓪(ELSIF ObjectType (head) = boxTextObj THEN nameIdx := head END;⓪(⓪(IF head # tail THEN head := RightSister (head)⓪(ELSE EXIT END;⓪(⓪&END;⓪&⓪$END;⓪"END InitWorkfile;⓪ ⓪ PROCEDURE InitSS () :BOOLEAN;⓪ ⓪"(* installDriveIcons -- Das 'drives'-Array wird init. und für jedes vor-⓪#* handene LW wird ein Icon auf dem Desktop erzeugt.⓪#* ACHTUNG: Voraussetzung ist, das LW A: vorhanden ist.⓪#*)⓪ ⓪"PROCEDURE installDriveIcons;⓪"⓪$CONST bufferSize = 4096; (* 4k are necessary for TT *)⓪"⓪$VAR d,d2 : Drive;⓪*⓪*p, q : Point;⓪*f1, f2 : Rectangle;⓪*text : String;⓪*p1, p2 : PtrBitPattern;⓪*t : ObjType;⓪*s : Rectangle;⓪*col1, col2,⓪*pos, len : CARDINAL;⓪*fl : OFlagSet;⓪*obj : CARDINAL;⓪*infBuf : ARRAY[0..bufferSize - 1] OF CHAR;⓪*online : DriveSet;⓪*found : BOOLEAN;⓪(⓪$BEGIN⓪&online := DriveSet (DrivesOnline ());⓪&SetCurrObjTree (desk, FALSE);⓪&FOR d := minDrv TO maxDrv DO⓪(drives[d].available := FALSE;⓪(hideObj (drives[d].treeIndex, TRUE);⓪&END;⓪&⓪&(* get the object parm.s from drive A:⓪'*)⓪'⓪&obj := Drivea;⓪&t := ObjectType (obj); s := ObjectSpace (obj);⓪&fl := ObjectFlags (obj) - OFlagSet{lastObjFlg, hideTreeFlg};⓪&GetIconColor (obj, col1, col2);⓪&GetIconForm (obj, p, f1, f2);⓪&GetIconLook (obj, p1, p2, void128, voidCh);⓪&⓪&ShellGet (infBuf, 0); pos := 0; len := Length (infBuf);⓪&⓪&FOR d := drvA TO maxDrv DO⓪(IF d IN online THEN⓪*drives[d].available := TRUE;⓪*obj := drives[d].treeIndex;⓪*SetObjType (obj, t);⓪*SetObjSpace (obj, TransRect (s, MinPoint (ObjectSpace (obj))));⓪*ensureVisibility (obj);⓪*SetObjFlags (obj, fl);⓪*IF obj # Drivea THEN⓪,CreateSpecification (obj, NIL);⓪,IF ObjTreeError () THEN doAlert (memFullAlt) END;⓪*END;⓪*SetIconColor (obj, col1, col2);⓪*SetIconForm (obj, p, f1, f2);⓪7⓪*(* get disk name *)⓪*pos := 0;⓪*found := FALSE;⓪*LOOP⓪,pos := PosLen ('#M', infBuf, pos);⓪,IF pos >= len THEN EXIT END;⓪,pos := pos + 17;⓪,Concat (infBuf[pos - 2], ':', text, voidO);⓪,d2 := Drive (StrToDrive (text));⓪,IF (d2 IN online) & (d2 = d) THEN⓪.Copy (infBuf, pos, PosLen ('@', infBuf, pos) - pos, text, found);⓪.EXIT;⓪,END;⓪*END;⓪*IF found THEN⓪,SetIconLook (obj, p1,p2,create,text,CHR (ORD ('A') + ORD (d) - 1 ))⓪*ELSE⓪,Assign ('Laufwerk',text,voidO);⓪,SetIconLook (obj, p1,p2,create,text,CHR (ORD ('A') + ORD (d) - 1 ))⓪*END;⓪(END;⓪&END;⓪&⓪$END installDriveIcons;⓪"⓪"VAR success: BOOLEAN;⓪*slot : wdwSlotIdx;⓪*devParm: PtrDevParm;⓪*space : Rectangle;⓪*x, w : INTEGER;⓪"⓪"BEGIN⓪$IF MemAvail () < minNecessaryMem THEN RETURN FALSE END;⓪$⓪$InitGem (RC,dev, success);⓪$IF ~ success THEN⓪&IF GemActive () THEN⓪(multiStringAlert (noGemAlt1,noGemAlt2, voidC);⓪&END;⓪&RETURN FALSE⓪$ELSE⓪&gemHdl:=CurrGemHandle ();⓪$END;⓪$ShellPath:= HomePath;⓪$⓪$GEMBase.GetPBs (gemHdl, vdiPB, aesPB);⓪$multiGEM:= aesPB.pglobal^.count > 1;⓪$multiTOS:= aesPB.pglobal^.count = -1;⓪$⓪ (*$ ? DebugWdw:⓪"⓪$TextWindows.Open (dWdw, 40,20, WQualitySet{titled, dynamic, movable},⓪6TextWindows.noHideWdw, noForce, ' Debug - Fenster ',⓪655,3,20,10, voidO);⓪$⓪!*)⓪#⓪$deskSize := DeskSize ();⓪$CharSize (dev, charWidth, charHeight);⓪$IF deskSize.x MOD INTEGER (charWidth) # 0⓪$THEN⓪&alignedDeskSize.x := deskSize.x + INTEGER (charWidth)⓪;- deskSize.x MOD INTEGER (charWidth);⓪&alignedDeskSize.w := deskSize.w - (alignedDeskSize.x - deskSize.x);⓪$ELSE⓪&alignedDeskSize.x := deskSize.x;⓪&alignedDeskSize.w := deskSize.w;⓪$END;⓪$IF deskSize.y MOD INTEGER (charHeight) # 0⓪$THEN⓪&alignedDeskSize.y := deskSize.y + INTEGER (charHeight)⓪;- deskSize.y MOD INTEGER (charHeight);⓪&alignedDeskSize.h := deskSize.h - (alignedDeskSize.y - deskSize.y);⓪$ELSE⓪&alignedDeskSize.y := deskSize.y;⓪&alignedDeskSize.h := deskSize.h;⓪$END;⓪$⓪2(* Resource laden und Baumadressen ermitteln *)⓪2⓪$LoadResource (resourceFile);⓪$IF GemError () THEN⓪&multiStringAlert (noRscAlt1,noRscAlt2, voidC);⓪&ExitGem (gemHdl);⓪&TermProcess (0)⓪$END;⓪$⓪$menu := TreeAddress (Menu);⓪$msgBar := TreeAddress (Msgbar);⓪$desk := TreeAddress (Desktop);⓪$scanBox := TreeAddress (Scanbox);⓪$shellBox := TreeAddress (Shellbox);⓪$optBox := TreeAddress (Optbox);⓪$fileInfoBox := TreeAddress (Finfobox);⓪$fileBox := TreeAddress (Filebox);⓪$sNameBox := TreeAddress (Snamebox);⓪$argBox := TreeAddress (Argbox);⓪$linkBox := TreeAddress (Loptbox);⓪$loadBox := TreeAddress (Loadbox);⓪$fNameBox := TreeAddress (Fldrbox);⓪$shellParmBox := TreeAddress (Sparmbox);⓪$formatBox := TreeAddress (Formabox);⓪$confirmBox := TreeAddress (Confibox);⓪$editorParmBox := TreeAddress (Eparmbox);⓪$helpBox := TreeAddress (Helpbox);⓪$infoBox := TreeAddress (Infobox);⓪$⓪$noWindAlt := TextStringAddress (Nowdwalt);⓪$pathToLongAlt := TextStringAddress (Pathalt);⓪$windErrAlt := TextStringAddress (Windalt);⓪$cOptToLongAlt := TextStringAddress (Optalt);⓪$wrgIcon2Alt := TextStringAddress (Icon2alt);⓪$memFullAlt := TextStringAddress (Memalt);⓪$drvSpaceMsg := TextStringAddress (Spacemsg);⓪$debugAlt := TextStringAddress (Debugalt);⓪$parmSaveAlt := TextStringAddress (Parmsalt);⓪$formatAlt := TextStringAddress (Formaalt);⓪$formatErrAlt := TextStringAddress (Foerralt);⓪$noParmAlt := TextStringAddress (Noparalt);⓪$ContMakeAlt := TextStringAddress (Contmalt);⓪$noNewWorkAlt := TextStringAddress (Nowrkalt);⓪$exitShellAlt := TextStringAddress (Exitalt);⓪$loadFailedAlt := TextStringAddress (Loadalt);⓪$noHelpAlt := TextStringAddress (Nohlpalt);⓪$fontErrAlt := TextStringAddress (Alrtfont);⓪$⓪$NoLoadStr := TextStringAddress (Noldstr);⓪$OkStr := TextStringAddress (Okstr);⓪$EditStr := TextStringAddress (Editstr);⓪$EditBatStr := TextStringAddress (Editbstr);⓪$NoPathsStr := TextStringAddress (Npathstr);⓪$NoUnloadStr := TextStringAddress (Nouldstr);⓪$NoExecStr := TextStringAddress (Noexestr);⓪$RetStr := TextStringAddress (Retstr);⓪$EdStr := TextStringAddress (Edstr);⓪$WorkStr := TextStringAddress (Workstr);⓪$CompStr := TextStringAddress (Compstr);⓪$LinkStr := TextStringAddress (Linkstr);⓪$InfStr := TextStringAddress (Infstr);⓪$ContStr := TextStringAddress (Contstr);⓪$MakeStr := TextStringAddress (Makestr);⓪$⓪$⓪2(* 'desk' und 'msgBar'-Ausmaße der Größe⓪3* des Ausgabegeräts anpassen⓪3*)⓪"⓪$devParm := DeviceParameter (dev);⓪$⓪$SetCurrObjTree (desk, FALSE);⓪$space := ObjectSpace (Root);⓪$space.w := devParm^.rasterWidth + 1;⓪$space.h := devParm^.rasterHeight + 1;⓪$SetObjSpace (Root, space);⓪$⓪$SetCurrObjTree (msgBar, FALSE);⓪$space.h := deskSize.y-1;⓪$SetObjSpace (Root, space);⓪$SetObjSpace (Mbmsg, space);⓪$⓪$LinkTextString (Mbmsg, ADR (msgStr));⓪ ⓪2(* Indizes ermitteln *)⓪ ⓪$linkBoxIdx[1].check := Locheck1;⓪$linkBoxIdx[1].path := Lofname1;⓪$linkBoxIdx[2].check := Locheck2;⓪$linkBoxIdx[2].path := Lofname2;⓪$linkBoxIdx[3].check := Locheck3;⓪$linkBoxIdx[3].path := Lofname3;⓪$linkBoxIdx[4].check := Locheck4;⓪$linkBoxIdx[4].path := Lofname4;⓪$linkBoxIdx[5].check := Locheck5;⓪$linkBoxIdx[5].path := Lofname5;⓪$linkBoxIdx[6].check := Locheck6;⓪$linkBoxIdx[6].path := Lofname6;⓪$linkBoxIdx[7].check := Locheck7;⓪$linkBoxIdx[7].path := Lofname7;⓪$linkBoxIdx[8].check := Locheck8;⓪$linkBoxIdx[8].path := Lofname8;⓪$⓪2(* Bäume initalisieren *)⓪2⓪$drives[drvA].treeIndex := Drivea;⓪$drives[drvB].treeIndex := Driveb;⓪$drives[drvC].treeIndex := Drivec;⓪$drives[drvD].treeIndex := Drived;⓪$drives[drvE].treeIndex := Drivee;⓪$drives[drvF].treeIndex := Drivef;⓪$drives[drvG].treeIndex := Driveg;⓪$drives[drvH].treeIndex := Driveh;⓪$drives[drvI].treeIndex := Drivei;⓪$drives[drvJ].treeIndex := Drivej;⓪$drives[drvK].treeIndex := Drivek;⓪$drives[drvL].treeIndex := Drivel;⓪$drives[drvM].treeIndex := Drivem;⓪$drives[drvN].treeIndex := Driven;⓪$drives[drvO].treeIndex := Driveo;⓪$drives[drvP].treeIndex := Drivep;⓪$⓪$(* init. work file obj.s⓪%*)⓪$SetCurrObjTree (desk, FALSE);⓪$InitWorkfile (0, Work0);⓪$InitWorkfile (1, Work1);⓪$InitWorkfile (2, Work2);⓪$InitWorkfile (3, Work3);⓪$InitWorkfile (4, Work4);⓪$InitWorkfile (5, Work5);⓪$InitWorkfile (6, Work6);⓪$InitWorkfile (7, Work7);⓪$InitWorkfile (8, Work8);⓪$InitWorkfile (9, Work9);⓪$⓪$ensureVisibility (Trash);⓪$ensureVisibility (Edit); ensureVisibility (Compile);⓪$ensureVisibility (Execute); ensureVisibility (Link);⓪$ensureVisibility (Resident); ensureVisibility (Scan);⓪$ensureVisibility (Currfile);⓪$⓪$SetTextString (fileBox, Cfedit, '');⓪$SetTextString (shellBox, Version, ShellRevision);⓪$⓪$⓪2(* Initalisiere 'Tools'-Indizies *)⓪2⓪$ToolField[1].index := Mtool1;⓪$ToolField[2].index := Mtool2;⓪$ToolField[3].index := Mtool3;⓪$ToolField[4].index := Mtool4;⓪$ToolField[5].index := Mtool5;⓪$ToolField[6].index := Mtool6;⓪$ToolField[7].index := Mtool7;⓪$ToolField[8].index := Mtool8;⓪$ToolField[9].index := Mtool9;⓪$ToolField[10].index := Mtool10;⓪$⓪$(* init of the window slots⓪%*)⓪$⓪$x := firstWdwColumn;⓪$w := (screenColumns - firstWdwColumn - dirVisibleWidth) DIV maxWdw;⓪$⓪$FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO⓪$⓪&NEW (wdws[slot]);⓪&WITH wdws[slot]^ DO⓪(CreateWL (wl, FALSE, Rect (x, CenterWindowWL,⓪CdirVisibleWidth, MaxWindowWL));⓪(used := FALSE;⓪(noSelected := 0;⓪(x := x + w;⓪&END;⓪&⓪$END;⓪$⓪$TemporaryPath:= ShellPath;⓪$LoadParameter (shellParm.parameterPath);⓪$⓪$installDriveIcons;⓪$⓪$ShowSS (TRUE);⓪$⓪$RETURN TRUE;⓪"END InitSS;⓪ ⓪ PROCEDURE HideSS (complete: BOOLEAN);⓪ ⓪"BEGIN⓪$scanSlots (hideWdw, voidSlot, voidO);⓪$IF complete THEN ClearDeskAndShowMsg END;⓪$ShowBee;⓪"END HideSS;⓪ ⓪ PROCEDURE ExitSS;⓪ ⓪"VAR slot: wdwSlotIdx;⓪"⓪"BEGIN⓪$msgStr := '';⓪$HideSS (TRUE);⓪$⓪$(* deinit of the window slots⓪%*)⓪$⓪$FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO WITH wdws[slot]^ DO⓪&DeleteWL (wl);⓪&DISPOSE (wdws[slot]);⓪$END END;⓪$⓪$FreeResource;⓪$(* ExitGem (gemHdl); *)⓪"END ExitSS;⓪ ⓪*⓪0(* Routinen zur Event-Verarbeitung *)⓪0(* =============================== *)⓪ ⓪ (* keyManager -- Bearbeitet alle keyboard events⓪!*)⓪ ⓪ (*$Z-*)⓪ PROCEDURE keyManager (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"CONST aCode = BYTE (30); (* Buchstabentasten *)⓪*cCode = BYTE (46);⓪*eCode = BYTE (18);⓪*fCode = BYTE (33);⓪*iCode = BYTE (23);⓪*lCode = BYTE (38);⓪*nCode = BYTE (49);⓪*mCode = BYTE (50);⓪*oCode = BYTE (24);⓪*pCode = BYTE (25);⓪*qCode = BYTE (16);⓪*rCode = BYTE (19);⓪*sCode = BYTE (31);⓪*uCode = BYTE (22);⓪*xCode = BYTE (45);⓪*⓪*code1A = BYTE (2); (* Ziffern *)⓪*code0A = BYTE (11);⓪*code7N = BYTE (103);⓪*code0N = BYTE (112);⓪*⓪*plusCode= BYTE (27); (* <+> *)⓪*⓪*clrHome = BYTE (71); (* <Clr>-Taste *)⓪*delete = BYTE (83); (* <Delete>-Taste *)⓪*help = BYTE (98); (* <Help>-Taste *)⓪*escape = BYTE (1); (* <Esc>-Taste *)⓪*f1 = BYTE (59); (* <F1> *)⓪*f10 = BYTE (68); (* <F10> *)⓪*shiftF1 = BYTE (84); (* Shift + <F1> *)⓪*shiftF10= BYTE (93); (* Shift + <F10> *)⓪"⓪"VAR buts : MButtonSet;⓪*loc : Point;⓪*⓪*slot : wdwSlotIdx;⓪*slotPtr : ptrWdwSlot;⓪*success : BOOLEAN;⓪*msg : String;⓪*⓪$PROCEDURE withoutCtrl () :BOOLEAN;⓪$BEGIN⓪&RETURN ~ (controlKey IN specials)⓪$END withoutCtrl;⓪"⓪"BEGIN⓪"⓪$(* MouseKeyState (loc, buts, specials); *)⓪$CASE ch.scan OF⓪$⓪&escape : scanSlots (isTopWdw, slot, success); (* update window *)⓪1IF success THEN⓪1⓪3slotPtr := wdws[slot];⓪3CASE slotPtr^.kind OF⓪1⓪5dirWdw : ForceMediaChange (StrToDrive (slotPtr^.path)) |⓪5modWdw : slotPtr^.all := (alternateKey IN specials)|⓪5⓪3END;⓪3updateWdw (slotPtr);⓪3⓪1END|⓪(⓪&(* Icons *)⓪&⓪&aCode : actManager (Execute, specials, withoutCtrl (), FALSE, FALSE)|⓪&cCode : IF withAlt (specials) THEN doCompilerOptionBox⓪1ELSE⓪3actManager (Compile, specials, withoutCtrl (), FALSE, FALSE)⓪1END|⓪&eCode : IF withAlt (specials) THEN doEditorParameterBox⓪1ELSE⓪3actManager (Edit, specials, withoutCtrl (), FALSE, FALSE)⓪1END|⓪&lCode : IF withAlt (specials) THEN doLinkerOptionBox⓪1ELSE⓪3actManager (Link, specials, withoutCtrl (), FALSE, FALSE)⓪1END|⓪&sCode : actManager (Scan, specials, withoutCtrl (), FALSE, FALSE)|⓪&rCode : actManager (Resident, specials, withoutCtrl (), FALSE, FALSE)|⓪&plusCode : actManager (Compile, specials, withoutCtrl (), FALSE, TRUE)|⓪&⓪&pCode : IF withCtrl (specials) THEN doFileBox (noCurrentWorkfile)⓪1ELSIF WorkField.current # noCurrentWorkfile THEN⓪3doFileBox (WorkField.current);⓪1END|⓪&⓪&mCode : Concat ('Making: ', MakeFileName, msg, voidO);⓪1truncCopyString (msg, msgStrLen, msgStr);⓪1action (doDftM, FALSE, FALSE)|⓪ ⓪&(* Menu: Datei *)⓪&⓪&iCode : inform|⓪&oCode : makeFolder|⓪&clrHome : IF withBothShifts (specials)⓪1THEN⓪3scanSlots (closeWdw, voidSlot, voidO);⓪1ELSE⓪3closeTopWdw (withShift (specials));⓪1END|⓪&nCode : makeNewWorkfile|⓪&delete : killWorkfile|⓪&qCode : IF withCtrl (specials) THEN quitStatus := quickQuit⓪1ELSE quitStatus := quit END|⓪&⓪&(* Menu: Parameter *)⓪&⓪&xCode : IF withCtrl (specials) THEN saveParameter⓪1ELSE doShellParameterBox END|⓪&⓪&(* Menu: Info *)⓪&⓪&uCode : doInfoBox|⓪&help : IF withShift (specials) THEN editDocu (specials)⓪1ELSE doHelpBox (helpFile) END|⓪&⓪&(* Menu: Tools *)⓪&⓪&f1..f10 : executeTool (ORD (ch.scan) - ORD (f1) + 1, specials)|⓪&shiftF1..shiftF10⓪/: INCL (specials, leftShiftKey);⓪1executeTool (ORD (ch.scan) - ORD (shiftF1) + 1, specials)|⓪&⓪&(* work files *)⓪&⓪&code1A..code0A,⓪&code7N..code0N⓪/: selectWorkfile (ORD (ch.ascii) - ORD ('0'))|⓪1⓪$ELSE RETURN TRUE END;⓪$⓪$RETURN FALSE;⓪"END keyManager;⓪ ⓪ (* butManager -- Bearbeitet alle mouse button events⓪!*)⓪ ⓪ PROCEDURE moveFiles (slotPtr: ptrWdwSlot; loc: Point; specials: SpecialKeySet);⓪ ⓪"VAR result : targetObject;⓪(success,⓪(foundDrive,⓪(foundWorkfile: BOOLEAN;⓪(objKind : dragObjectKind;⓪(name,⓪(destPath : Str128;⓪(kindOfName : nameKind;⓪(dirEntryPtr : ptrDirEntry;⓪(drive : Drive;⓪(workfileIdx : CARDINAL;⓪ ⓪"BEGIN⓪$getSelectedName (name, voidSlot, kindOfName);⓪$IF kindOfName = fileNK THEN objKind := fileDOK⓪$ELSE objKind := filesDOK END;⓪$⓪$moveFileModul (slotPtr, objKind, loc, result, success);⓪$IF ~ success THEN RETURN END;⓪$⓪$toggleTarget (result, FALSE);⓪$CASE result.kind OF⓪$⓪&objTOK: searchDrive (result.obj, drive, foundDrive);⓪.searchWorkfile (result.obj, workfileIdx, foundWorkfile);⓪.IF foundDrive THEN (* copy into drive *)⓪0Assign (DriveToStr (MOSGlobals.Drive(drive)), destPath, voidO);⓪0copyFiles (slotPtr, destPath, FALSE);⓪.ELSIF foundWorkfile THEN⓪0setWorkfileName (workfileIdx, currFn)⓪.ELSE (* action *)⓪0CASE result.obj OF⓪2Trash : deleteFiles (slotPtr);⓪=updateWdw (slotPtr)|⓪2Edit,⓪2Compile,⓪2Execute,⓪2Link,⓪2Resident,⓪2Scan : actManager (result.obj, specials,⓪IFALSE, FALSE, FALSE)|⓪0END;⓪.END|⓪.⓪&wdwTOK: IF (result.entry = NIL)⓪1OR NOT (selectedWL IN EntryAttributesWL (result.slotPtr^.wl,⓪Zresult.entry)) THEN⓪.⓪0IF result.slotPtr^.kind = dirWdw (* dir. wdw *)⓪0THEN⓪2destPath := result.slotPtr^.path; (* copy into wdw/folder *)⓪2IF result.valid THEN⓪4dirEntryPtr := ptrDirEntry (result.entry);⓪4appendPath (dirEntryPtr^.entry.name, destPath, success);⓪2END;⓪2copyFiles (slotPtr, destPath, FALSE);⓪2IF NOT result.valid THEN updateWdw (result.slotPtr) END;⓪2⓪0ELSE (* mod. wdw *)⓪2loadAndUnload (slotPtr, loadModuls)⓪0END;⓪0⓪.END|⓪0⓪$END;⓪$⓪"END moveFiles;⓪"⓪ PROCEDURE moveModuls (slotPtr: ptrWdwSlot; loc: Point; specials: SpecialKeySet);⓪ ⓪"VAR result : targetObject;⓪(success: BOOLEAN;⓪(kind : dragObjectKind;⓪ ⓪"BEGIN⓪$kind := modulDOK;⓪$IF slotPtr^.noSelected > 1 THEN kind := modulsDOK END;⓪$⓪$moveFileModul (slotPtr, kind, loc, result, success);⓪$IF ~ success THEN RETURN END;⓪ ⓪$CASE result.kind OF⓪$⓪&objTOK: CASE result.obj OF⓪&⓪0Execute : actManager (Execute, specials,⓪LFALSE, FALSE, FALSE)|⓪0Trash : (* HideSS (FALSE);⓪@action (doUnLd, FALSE, FALSE);⓪@ShowSS (FALSE);⓪A*)⓪@(*scanSlots (updateModWdw, voidSlot, voidO); *)⓪@loadAndUnload (slotPtr, unloadModuls)|⓪0⓪.ELSE doAlert (wrgIcon2Alt) END|⓪.⓪&wdwTOK: doAlert (wrgIcon2Alt)|⓪&⓪$END;⓪*⓪$toggleTarget (result, FALSE);⓪"END moveModuls;⓪ ⓪ ⓪ (*$Z-*)⓪ PROCEDURE butManager (clicks : CARDINAL;⓪6loc : Point;⓪6buts : MButtonSet;⓪6specials: SpecialKeySet): BOOLEAN;⓪ (*$Z=*)⓪ ⓪"VAR obj, but : CARDINAL;⓪*on : BOOLEAN;⓪*str10 : ARRAY[0..10] OF CHAR;⓪*lStr : Str128;⓪*sc : SpecialKeySet;⓪*⓪*slot : wdwSlotIdx;⓪*slotPtr : ptrWdwSlot;⓪*dirEntryPtr : ptrDirEntry;⓪*modEntryPtr : ptrModEntry;⓪*entry : ADDRESS;⓪*⓪*kindOfName : nameKind;⓪*⓪*mode : DetectModeWL;⓪*openCurrDir : BOOLEAN;⓪*loc2 : Point;⓪*⓪*drive : Drive;⓪*workfileIdx : CARDINAL;⓪*foundDrive,⓪*foundWorkfile,⓪*contSearch : BOOLEAN;⓪*⓪$PROCEDURE selectArea;⓪$⓪&VAR selMode: LONGCARD;⓪&⓪&BEGIN⓪(RubberBox (Rect (loc.x, loc.y, 0, 0), loc2);⓪2⓪(IF withShift (specials) THEN selMode := multipleSelect⓪(ELSE selMode := onlyOneSelected END;⓪(SelectAreaWL (slotPtr^.wl, Rect (loc.x, loc.y, loc2.x, loc2.y),⓪9selMode, multipleSelect);⓪&END selectArea;⓪$⓪$PROCEDURE withShiftOrRightButton (): BOOLEAN;⓪$⓪&BEGIN⓪(RETURN withShift (specials) OR (msBut2 IN buts)⓪&END withShiftOrRightButton;⓪&⓪"BEGIN (* butManager *)⓪"⓪$MouseKeyState (loc2, buts, sc); (* Welche Knöpfe sind noch gedrückt? *)⓪"⓪*(* Teste Fenster ab *)⓪"⓪$IF withCtrl (specials) THEN mode := scanWL ELSE mode := selectWL END;⓪$detectWdws (loc, mode, clicks, specials, buts, entry, slotPtr, contSearch);⓪$⓪$IF entry # NIL THEN (* a window entry is selected *)⓪$⓪&getSelectedName (currFn, voidSlot, kindOfName);⓪&⓪&CASE slotPtr^.kind OF⓪&⓪(dirWdw : dirEntryPtr := ptrDirEntry (entry); (* directory wdws *)⓪(⓪1IF clicks > 1 THEN (* double click *)⓪1⓪3IF isSubdir (dirEntryPtr^.entry) THEN⓪5AESUpdateWindow (TRUE);⓪5openFolder (slotPtr, dirEntryPtr);⓪5AESUpdateWindow (FALSE);⓪3ELSE⓪5IF IsSourceName (currFn) THEN⓪7actManager (Edit, specials, FALSE, FALSE, FALSE)⓪5ELSE⓪7actManager (Execute, specials, FALSE, FALSE, FALSE)⓪5END⓪3END;⓪3⓪1ELSIF msBut1 IN buts THEN(* button down *)⓪1⓪3IF withCtrl (specials) THEN⓪5selectArea⓪3ELSE⓪5moveFiles (slotPtr, loc, specials)⓪3END;⓪1⓪1ELSE (* simple click *)⓪3IF ~ isSubdir (dirEntryPtr^.entry) THEN⓪5setCurrTextAndCode (currFn)⓪3END;⓪1END|⓪1⓪(modWdw : modEntryPtr := ptrModEntry (entry); (* module wdws *)⓪(⓪1IF clicks > 1 THEN (* double click *)⓪1⓪3(* getSelectedName (currFn, voidSlot, kindOfName); *)⓪3actManager (Execute, specials, FALSE, FALSE, FALSE)⓪(⓪1ELSIF msBut1 IN buts THEN(* button down *)⓪1⓪3IF withCtrl (specials) THEN selectArea⓪3ELSE⓪5moveModuls (slotPtr, loc, specials)⓪3END;⓪3⓪1ELSE (* simple click *)⓪3setCurrTextAndCode (currFn)⓪1END|⓪(⓪&END;⓪$END;⓪"⓪$IF contSearch THEN (* 'findWind' ergab, daß kein Fenster selektiert wurde *)⓪*⓪*(* Teste Desktop ab *)⓪&⓪&obj := FindObject (desk, Root, MaxDepth, loc);⓪"⓪&IF obj = NoObject THEN⓪&⓪(RETURN TRUE (* kein eigenes Objekt -> Ende *)⓪(⓪&ELSE⓪(searchDrive (obj, drive, foundDrive);⓪(searchWorkfile (obj, workfileIdx, foundWorkfile);⓪(SetCurrObjTree (desk, FALSE);⓪(⓪(IF clicks > 1 THEN (* Doppelklick *)⓪(⓪*CASE obj OF⓪*⓪,Compile,⓪,Edit,⓪,Execute,⓪,Link,⓪,Resident,⓪,Scan : actManager (obj, specials, ~ (msBut2 IN buts),⓪DFALSE, FALSE)|⓪,⓪,Cftext,⓪,Cfcode : doFileBox (noCurrentWorkfile)|⓪,⓪*ELSE⓪,IF foundDrive THEN⓪,⓪.AESUpdateWindow (TRUE);⓪.selectDrive (drive);⓪.openCurrDir := (shellParm.defaultOpenCurrDir⓪>AND ~ withShiftOrRightButton ())⓪=OR (~ shellParm.defaultOpenCurrDir⓪AAND withShiftOrRightButton ());⓪.openDirWdw (slot, drive, openCurrDir);⓪.careOfDeselectDrive;⓪.AESUpdateWindow (FALSE);⓪,⓪,ELSIF foundWorkfile THEN doFileBox (workfileIdx) END;⓪*END;(*CASE -- Doppelklick *)⓪*⓪(ELSIF msBut1 IN buts THEN (* Button festgehalten *)⓪(⓪*CASE obj OF⓪*⓪,Compile,⓪,Edit,⓪,Execute,⓪,Link,⓪,Resident,⓪,Scan,⓪,Trash : moveDeskPart (obj)|⓪,⓪,Currfile,⓪,Cfhead : moveDeskPart (Currfile)|⓪,⓪,Cftext,⓪,Cfcode : (* moveFile (deskObjSpace (Cfname), FALSE,⓪BiconNo,destWind,destElem, moveResult);⓪8IF iconNo # NoObject THEN⓪:CASE iconNo OF⓪:⓪<Compile,⓪<Compexec,⓪<Edit,⓪<Execute,⓪<Link,⓪<Resident,⓪<Scan : actManager (iconNo, specials,⓪SFALSE, FALSE, FALSE)|⓪<⓪<Trash : setCurrTextAndCode ('')|⓪:ELSE⓪<(* nix *)⓪:END;⓪8ELSE⓪:(* nix⓪<IF moveResult # noWindMF THEN END;⓪:*)⓪8END*)|⓪,⓪*ELSE⓪,IF foundDrive THEN moveDeskPart (obj)⓪,ELSIF foundWorkfile THEN⓪.moveDeskPart (WorkField.elems[workfileIdx].carrierIdx)⓪,END;⓪*END;(* CASE -- Klick mit festhalten *)⓪*⓪(ELSE (* Einfacher Klick *)⓪(⓪*careOfDeselectDrive;⓪*careOfDeselectEntries;⓪*IF foundDrive THEN selectDrive (drive)⓪*ELSIF foundWorkfile THEN selectWorkfile (workfileIdx) END;⓪*⓪(END;(*IF -- Klickunterscheidung *)⓪&⓪&END;⓪$END;(*IF contSearch*)⓪$⓪$RETURN FALSE;⓪"END butManager;⓪ ⓪ (* menuManager -- Bearbeitet alle message events, die durch Anklicken der⓪!* Menuzeile entstehen.⓪!*)⓪!⓪ (*$Z-*)⓪ PROCEDURE menuManager (title, item: CARDINAL): BOOLEAN;⓪ (*$Z=*)⓪"⓪"VAR i : CARDINAL;⓪*buts : MButtonSet;⓪*specials: SpecialKeySet;⓪*loc : Point;⓪*start : Rectangle;⓪#⓪"BEGIN⓪$MouseKeyState (loc,buts,specials);⓪$CASE item OF⓪&⓪&(* MShell *)⓪%⓪&Dinfo : animateMenuTitle (Mshell, start);⓪2DoSimpleBox (shellBox, start, voidC);⓪2deAnimateMenuTitle (Mshell)|⓪&⓪&(* Datei *)⓪&⓪&Mdinfo : inform|⓪&Mdfolder : makeFolder|⓪&Mdformat : doFormatBox|⓪&Mdclose : closeTopWdw (FALSE)|⓪&Mdclosew : closeTopWdw (TRUE)|⓪&Mdnwork : makeNewWorkfile|⓪&Mdkwork : killWorkfile|⓪&Mdquit : quitStatus := quit|⓪&⓪&(* Parameter *)⓪&⓪&Mpshell : doShellParameterBox|⓪&Mpeditor : doEditorParameterBox|⓪&Mpcomp : doCompilerOptionBox|⓪&Mplink : doLinkerOptionBox|⓪&Mpsave : saveParameter|⓪&⓪&(* Info *)⓪&⓪&Mienv : doInfoBox|⓪&Mihelp : doHelpBox (helpFile)|⓪&Midocu : editDocu (specials)|⓪&⓪$ELSE⓪&⓪&(* Tools *)⓪$⓪&FOR i := 1 TO MaxTool DO⓪(IF item = ToolField[i].index THEN executeTool (i, specials) END⓪&END;⓪&⓪$END;⓪$⓪$NormalTitle (menu,title, TRUE);⓪$⓪$RETURN FALSE;⓪"END menuManager;⓪ ⓪ PROCEDURE TalkWithUser;⓪ ⓪"VAR worker : ARRAY [1..3] OF EventProc;⓪*⓪*slot, i : wdwSlotIdx;⓪*success : BOOLEAN;⓪*⓪*firstA3,⓪*newA3 : LONGCARD;⓪*⓪*button : CARDINAL;⓪"⓪"(* careOfNewName -- Falls ein Unterschied zwischen dem in 'str' enthaltenen⓪#* Filenamen und dem String des Objektes 'obj' des Desk-⓪#* top-Baumes besteht, so wird der Name aus 'str' in das⓪#* Objekt geschreiben und neugezeichnet.⓪#*)⓪#⓪"PROCEDURE careOfNewName (VAR str:ARRAY OF CHAR; obj:CARDINAL);⓪ ⓪$VAR lF, old: ARRAY[0..11] OF CHAR;⓪$⓪$BEGIN⓪&SplitPath (str, void128, lF);⓪&GetTextString (desk, obj, old);⓪&IF NOT StrEqual (old, lF) THEN⓪(SetTextString (desk, obj, lF);⓪(redrawDeskObj (obj);⓪&END;⓪$END careOfNewName;⓪"⓪ ⓪"BEGIN⓪$careOfNewName (lastFn, Cftext); (* Aktuelles File aktual. *)⓪$careOfNewName (CodeName, Cfcode);⓪"⓪$worker[1].event := keyboard;⓪$worker[1].keyHdler := keyManager;⓪$worker[2].event := mouseButton;⓪$worker[2].butHdler := butManager;⓪$worker[3].event := message;⓪$worker[3].msgType := menuSelected;⓪$worker[3].menuHdler := menuManager;⓪"⓪$STORE (11, firstA3);⓪"⓪$REPEAT⓪"⓪&HandleEvents (2, MButtonSet{msBut1}, MButtonSet{msBut1},⓪4lookForEntry, Rect (0,0,0,0),⓪4lookForEntry, Rect (0,0,0,0),⓪40, worker, 0);⓪"⓪&STORE (11, newA3);⓪&IF newA3 # firstA3 THEN⓪(LOAD (firstA3, 11);⓪(FormAlert (1, '[1][Heap fault][ OK ]', voidC);⓪&END;⓪&⓪&enableAndDisableMenuItems;⓪"⓪&FOR i := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO⓪(wdws[i]^.isTop := FALSE;⓪&END;⓪&scanSlots (isTopWdw, slot, success);⓪&IF success THEN⓪&⓪(wdws[slot]^.isTop := TRUE;⓪(IF wdws[slot]^.kind = dirWdw THEN⓪*SetDefaultPath (wdws[slot]^.path, voidI);⓪(END;⓪(⓪&END;⓪"⓪&currFn := ''; (* Damit 'lastFn' zum Zuge kommen kann *)⓪&⓪&careOfNewName (lastFn, Cftext); (* Aktuelles File aktual. *)⓪&careOfNewName (CodeName, Cfcode);⓪"⓪&(* handle a quit shell request⓪'*)⓪&IF quitStatus = quit THEN⓪(FormAlert (1, exitShellAlt^, button);⓪(IF button = 3 THEN quitStatus := noQuit⓪(ELSIF button = 1 THEN SaveParameter END;⓪&END;⓪$⓪$UNTIL quitStatus # noQuit;⓪"END TalkWithUser;⓪ ⓪ (*$Z-*)⓪ PROCEDURE hdlTrap5 (VAR desc: ExcDesc): BOOLEAN;⓪ (*$Z=*)⓪"BEGIN⓪$doAlert (debugAlt); (* Fehlermeldung *)⓪$TermProcess (0); (* und ab damit *)⓪$RETURN FALSE (* Nur um des Compilers Willen *)⓪"END hdlTrap5;⓪ ⓪ ⓪ VAR i : CARDINAL;⓪(hdl : ADDRESS;⓪(wsp : MemArea;⓪ ⓪ BEGIN (* ShellShell *)⓪ ⓪"(* Vom Modula-System und der Shell benutzte Suffices:⓪#*)⓪"suf[prg] := 'PRG';⓪"suf[app] := 'APP';⓪"suf[tos] := 'TOS';⓪"suf[ttp] := 'TTP';⓪"suf[m2p] := 'M2P';⓪"suf[m2b] := 'M2B';⓪"suf[m2m] := 'M2M';⓪"suf[m2d] := 'M2D';⓪"(*⓪#* Die folgenden Endungen können verändert werden:⓪#* (Shell dann neu linken und alle Dateien mit den neuen Endungen⓪#* versehen - auch diejenigen in der Library "MM2DEF.M2L"!)⓪#*)⓪"suf[mod] := 'MOD'; (* Object-Files, GEM-Application *)⓪"suf[mos] := 'MOS'; (* Object-Files, TOS-Application *)⓪"suf[mtp] := 'MTP'; (* Object-Files, TTP-Application *)⓪"suf[imp] := 'IMP'; (* Object-Files bei Implementationsmodulen *)⓪"suf[def] := 'DEF'; (* Symbol-Files (übersetzte Definitionsmodule *)⓪"DefSrcSfx:= 'D'; (* ModRef: Definitions-Texte *)⓪"ImpSrcSfx:= 'I'; (* ModRef: Implementations-Texte *)⓪"ModSrcSfx:= 'M'; (* ModRef: Hauptmodul-Texte *)⓪ ⓪"(* Für Compiler: Suffices für erzeugte Dateien *)⓪"DefSfx:= suf[def]; (* Extension f. Symboldatei-Codes *)⓪"ImpSfx:= suf[imp]; (* Extension f. Implementations-Codes *)⓪"ModSfx:= suf[mod]; (* Extension f. Hauptmodul-Codes *)⓪ ⓪"(* Suffices für Loader (CallModule, LoadModule) *)⓪"MOSConfig.DftSfx:= suf[mod]; (* Default-Endung bei 'CallModule' *)⓪"MOSConfig.ImpSfx:= suf[imp]; (* Endung der importierten Module *)⓪ ⓪"(* calc. of the directory window width (including the date)⓪#*)⓪"dirDateLen := Length (StdDateMask);⓪"dirWdwWidth := dirWidthNoDate + dirDateLen;⓪"⓪"(* some box info vars⓪#*)⓪"LastCodeName := '';⓪"LastCodeSize := 0L;⓪ ⓪"(* default configuration⓪#*)⓪ ⓪"MakeFileName := '';⓪ ⓪"WITH shellParm DO⓪$breakActive := TRUE;⓪$defaultOpenCurrDir := FALSE;⓪$confirmCopy := TRUE;⓪$confirmDelete := TRUE;⓪$useAllMemForCopy := TRUE;⓪$⓪$batchPath := batchFile;⓪$⓪$ShellRead (ShellName, args); (* Liest Pfad/Name der Shell und Argumentzeile *)⓪$IF args [0] # 0C THEN⓪&(* M2P-Dateiname wurde in Argumentzeile übergeben *)⓪&Assign (args, parameterPath, voidO)⓪$ELSE⓪&(* M2P-Dateiname wird aus Shell-Pfad u. "MM2SHELL.M2P" zusammengesetzt *)⓪&ConcatPath (ShellName, parameterFile, parameterPath)⓪$END;⓪$ConcatName (parameterPath, suf[m2p], parameterPath);⓪$MakeFullPath (parameterPath, voidI);⓪$⓪$sides := 2;⓪$tracks := 80;⓪$sectors := 9;⓪$⓪$waitOnReturn := FALSE;⓪"END;⓪"⓪"(* no work file.⓪#*)⓪"FOR i := 0 TO maxWorkFiles - 1 DO WorkField.elems[i].used := FALSE END;⓪"WorkField.noUsed := 0;⓪"WorkField.current := noCurrentWorkfile;⓪"⓪"WITH EditorParm DO⓪$name:= 'GME';⓪$searchSources := FALSE;⓪$waitOnError := FALSE;⓪$tempShellFile := FALSE;⓪$tempShellName := '';⓪$tempEditorFile := FALSE;⓪$tempEditorName := '';⓪$passArgument := TRUE;⓪$passName := TRUE;⓪$passErrorText := TRUE;⓪$passErrorPos := TRUE;⓪"END;⓪"⓪"ErrListFile := 'MODULA.ERR';⓪"MainOutputPath := '';⓪"WITH CompilerParm DO (* Compiler-Parameter: *)⓪$name:= 'MM2Comp';⓪$shortMsgs := FALSE; (* - keine Kurzausgaben *)⓪$protocol := FALSE; (* - kein Protokoll *)⓪$protWidth := stdProtWidth;⓪$protName := '';⓪"END;⓪"⓪"WITH LinkerParm DO⓪$name := 'MM2Link';⓪$FOR i := MIN (LLRange) TO MAX (LLRange) DO⓪&linkList[i].valid := FALSE;⓪&linkList[i].name := '';⓪$END;⓪$optimize := fullOptimize; (* - Vollständige Optimierung *)⓪$linkStackSize := 0;⓪$maxLinkMod := 100;⓪$fastLoad := TRUE;⓪$fastCode := TRUE;⓪$fastMemory := TRUE;⓪$symbolFile:= FALSE;⓪$symbolArgs:= ''; (* optional: Argumente f. 'MM2LnkIO.OutputSymbols' *)⓪$outputName:= ''; (* optional: Name d. Ausgabedatei *)⓪"END;⓪"⓪"FOR i := 1 TO MaxTool DO ToolField[i].used := FALSE END; (* Keine Tools *)⓪"⓪"msgStr := '';⓪"selectedDrive := defaultDrv; (* Kein Laufwerk angewählt *)⓪"⓪"(* TRAP #5 belegen, um Fehlermeldung auszugeben, wenn in einem Modul $D+⓪#* verwendet wird, ohne 'Debug'-Modul importiert zu haben *)⓪"wsp.bottom := ADR (ExceptsStack);⓪"wsp.length := SIZE (ExceptsStack);⓪"InstallPreExc (ExcSet{TRAP5}, hdlTrap5, TRUE, wsp, hdl);⓪ ⓪"quitStatus := noQuit;⓪ ⓪ END ShellShell;⓪ ⓪ ⓪((***************************)⓪((* Hier endet 'ShellShell' *)⓪((***************************)⓪ ⓪ ⓪ CONST mspFileMagic = 10071898L + 00700000000L;⓪(escKey = 33C;⓪ ⓪ TYPE PtrStr = POINTER TO String;⓪(AutoCmd = (noCmd, scan, edit, compile, execute, comp_exec, exec_src,⓪3make_exec, dftMake, dftMake_exec, contMake);⓪ ⓪ VAR ready : BOOLEAN;⓪%dummy : INTEGER;⓪%handle : INTEGER;⓪%strVal : BOOLEAN;⓪%buttonNum: CARDINAL;⓪%editorsMakeCmd,⓪%autoCmd : AutoCmd;⓪%shellStart,⓪%makeActive : BOOLEAN;⓪%callRes : LoaderResults;⓪%callMsg : String;⓪%exitCode : INTEGER;⓪%voidO : BOOLEAN;⓪%voidI : INTEGER;⓪%voidC : CARDINAL;⓪ ⓪%withPost1, withPost2: BOOLEAN;⓪%postAmble1, postAmble2, postArgs1, postArgs2: String;⓪ ⓪ ⓪ PROCEDURE FileAlert (errNo: INTEGER);⓪ ⓪"VAR msg : ARRAY[0..50] OF CHAR;⓪ ⓪"BEGIN⓪$IF (errNo < fOK) AND (errNo # fDriveNotReady) AND (errNo # fWriteProtected)⓪$THEN⓪&GetStateMsg (errNo, msg);⓪&Concat ('[1][', msg, msg, voidO);⓪&Append ('][ OK ]', msg, voidO);⓪&FormAlert (1, msg, voidC);⓪$END;⓪"END FileAlert;⓪ ⓪ PROCEDURE SaveParameter;⓪ ⓪"VAR f : File;⓪"⓪"PROCEDURE ioErr (): BOOLEAN;⓪"⓪$VAR ioRes: INTEGER;⓪"⓪$BEGIN⓪&ioRes := State (f);⓪&IF ioRes < fOK THEN⓪(ResetState (f);⓪(FileAlert (ioRes);⓪(Remove (f);⓪(ShowArrow;⓪&END;⓪&RETURN ioRes < fOK⓪$END ioErr;⓪$⓪"PROCEDURE wBlock (VAR data: ARRAY OF BYTE): BOOLEAN;⓪"⓪$BEGIN⓪&WriteBlock (f, data);⓪&RETURN ~ ioErr ()⓪$END wBlock;⓪"⓪"VAR magic: LONGCARD;⓪(ok: BOOLEAN;⓪"BEGIN⓪$ShowBee;⓪$⓪$Create (f, HomeReplaced (shellParm.parameterPath), writeOnly, replaceOld);⓪$IF State (f) # fOK THEN FileAlert (State (f)); RETURN END;⓪$⓪$magic := mspFileMagic;⓪$LOOP (* Ist keine echte Schleife - lediglich f. einfacheres EXIT *)⓪&ok:= FALSE;⓪&IF ~ wBlock (magic) THEN EXIT END;⓪&IF ~ wBlock (shellParm) THEN EXIT END;⓪&IF ~ wBlock (WorkField) THEN EXIT END;⓪&IF ~ wBlock (lastFn) THEN EXIT END;⓪&IF ~ wBlock (CodeName) THEN EXIT END;⓪&IF ~ wBlock (EditorParm) THEN EXIT END;⓪&IF ~ wBlock (CompilerParm) THEN EXIT END;⓪&IF ~ wBlock (LinkerParm) THEN EXIT END;⓪&IF ~ wBlock (DefaultStackSize) THEN EXIT END;⓪&IF ~ wBlock (TemporaryPath) THEN EXIT END;⓪&IF ~ wBlock (MakeFileName) THEN EXIT END;⓪&IF ~ wBlock (DefLibName) THEN EXIT END;⓪&IF ~ wBlock (ErrListFile) THEN EXIT END;⓪&IF ~ wBlock (MainOutputPath) THEN EXIT END;⓪&IF ~ wBlock (CompilerArgs) THEN EXIT END;⓪&SetGetDeskPositions (f, getValue); IF ioErr () THEN EXIT END;⓪&SetGetWindows (f, getValue); IF ioErr () THEN EXIT END;⓪&IF ~ wBlock (fontSetting) THEN EXIT END;⓪&ok:= TRUE;⓪&EXIT⓪$END;⓪$IF NOT ok THEN RETURN END;⓪$⓪$Close (f);⓪$⓪$ShowArrow;⓪"END SaveParameter;⓪ ⓪ PROCEDURE LoadParameter (REF name: ARRAY OF CHAR);⓪ ⓪"VAR f : File;⓪(fname : FileStr;⓪ ⓪"PROCEDURE ioErr (): BOOLEAN;⓪"⓪$VAR ioRes: INTEGER;⓪"⓪$BEGIN⓪&ioRes := State (f);⓪&IF ioRes < fOK THEN⓪(ResetState (f);⓪(FileAlert (ioRes);⓪(Close (f);⓪(ShowArrow;⓪&END;⓪&RETURN ioRes < fOK⓪$END ioErr;⓪$⓪"PROCEDURE rBlock (VAR data: ARRAY OF BYTE): BOOLEAN;⓪"⓪$BEGIN⓪&ReadBlock (f, data);⓪&RETURN ~ ioErr ()⓪$END rBlock;⓪ ⓪"VAR magic, n: LONGCARD;⓪(ch: CHAR;⓪(ok: BOOLEAN;⓪"⓪"BEGIN⓪$ShowBee;⓪$⓪$Assign (name, fname, voidO);⓪$ReplaceHome (fname);⓪$MakeFullPath (fname, voidI);⓪$Open (f, fname, readOnly);⓪$IF State (f) # fOK THEN FormAlert (1, noParmAlt^, voidC); ShowArrow; RETURN END;⓪$⓪$IF ~ rBlock (magic) THEN ShowArrow; RETURN END;⓪$IF magic = mspFileMagic THEN⓪&LOOP (* Ist keine echte Schleife - lediglich f. einfacheres EXIT *)⓪(ok:= FALSE;⓪(IF ~ rBlock (shellParm) THEN EXIT END;⓪(IF ~ rBlock (WorkField) THEN EXIT END;⓪(IF ~ rBlock (lastFn) THEN EXIT END;⓪(IF ~ rBlock (CodeName) THEN EXIT END;⓪(IF ~ rBlock (EditorParm) THEN EXIT END;⓪(IF ~ rBlock (CompilerParm) THEN EXIT END;⓪(IF ~ rBlock (LinkerParm) THEN EXIT END;⓪(IF ~ rBlock (DefaultStackSize) THEN EXIT END;⓪(IF ~ rBlock (TemporaryPath) THEN EXIT END;⓪(IF ~ rBlock (MakeFileName) THEN EXIT END;⓪(IF ~ rBlock (DefLibName) THEN EXIT END;⓪(IF ~ rBlock (ErrListFile) THEN EXIT END;⓪(IF ~ rBlock (MainOutputPath) THEN EXIT END;⓪(IF ~ rBlock (CompilerArgs) THEN EXIT END;⓪(SetGetDeskPositions (f, setValue); IF ioErr () THEN EXIT END;⓪(SetGetWindows (f, setValue); IF ioErr () THEN EXIT END;⓪(IF ~EOF (f) THEN⓪*IF ~rBlock (fontSetting) THEN EXIT END;⓪(ELSE⓪*fontSetting.name:= '';⓪*fontSetting.size:= 0;⓪(END;⓪(ok:= TRUE;⓪(EXIT⓪&END;⓪&IF NOT ok THEN ShowArrow; RETURN END;⓪ ⓪&InitWorkfile (0, Work0);⓪&InitWorkfile (1, Work1);⓪&InitWorkfile (2, Work2);⓪&InitWorkfile (3, Work3);⓪&InitWorkfile (4, Work4);⓪&InitWorkfile (5, Work5);⓪&InitWorkfile (6, Work6);⓪&InitWorkfile (7, Work7);⓪&InitWorkfile (8, Work8);⓪&InitWorkfile (9, Work9);⓪&Assign (fname, shellParm.parameterPath, voidO);⓪&SetFonts;⓪&SetWindowSizes;⓪$ELSE⓪&FormAlert (1, noParmAlt^, voidC)⓪$END;⓪$Close (f);⓪$⓪$(* If a batch file is specified, execute it. Don't load modules, if⓪%* the <ESC>-key is pressed.⓪%*)⓪$BusyRead (ch);⓪$IF NOT Empty (shellParm.batchPath) THEN⓪&ExecuteBatch (shellParm.batchPath, ch # escKey)⓪$END;⓪$⓪$ShowArrow;⓪"END LoadParameter;⓪ ⓪ ⓪ PROCEDURE PrepareScan;⓪ ⓪"BEGIN⓪$ScanAddr := CallingChain [ScanIndex].relAddr;⓪$ScanOpts := CallingChain [ScanIndex].codeOpts;⓪$Assign (CallingChain [ScanIndex].sourceName, TextName, voidO);⓪"END PrepareScan;⓪ ⓪ PROCEDURE readWorkNames;⓪"BEGIN⓪$WITH WorkField DO⓪&IF current >= 0 THEN⓪(workFName := elems[current].sourceName;⓪(workCName := elems[current].codeName;⓪&ELSE⓪(workFName := ''; workCName := '';⓪&END;⓪$END;⓪"END readWorkNames;⓪ ⓪ PROCEDURE writeWorkName (REF source, code: ARRAY OF CHAR);⓪"VAR i : INTEGER;⓪"BEGIN (* richtige Arbeitsdatei suchen und Code speichern *)⓪$WITH WorkField DO⓪&IF current >= 0 THEN⓪(FOR i:= 0 TO maxWorkFiles-1 DO⓪*IF elems[i].used & StrEqual (source, elems[i].sourceName) THEN⓪,Assign (code, elems[i].codeName, voidO);⓪,RETURN⓪*END⓪(END⓪&END;⓪$END;⓪"END writeWorkName;⓪ ⓪ PROCEDURE Bconout ( c: CHAR );⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #1,A3⓪(MOVEQ #0,D0⓪(MOVE.B -(A3),D0⓪(MOVE D0,-(A7)⓪(MOVE #2,-(A7)⓪(MOVE #3,-(A7)⓪(TRAP #13⓪(ADDQ.L #6,A7⓪$END⓪"END Bconout;⓪"(*$L=*)⓪ ⓪ (*$Z-*)⓪ PROCEDURE Bconin (): CHAR;⓪ (*$Z=*)⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE #2,-(A7)⓪(MOVE #2,-(A7)⓪(TRAP #13⓪(ADDQ.L #4,A7⓪(MOVE.B D0,(A3)+⓪(CLR.B (A3)+⓪$END⓪"END Bconin;⓪"(*$L=*)⓪ ⓪ (*$Z-*)⓪ PROCEDURE Bconstat (): BOOLEAN;⓪ (*$Z=*)⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE #2,-(A7)⓪(MOVE #1,-(A7)⓪(TRAP #13⓪(ADDQ.L #4,A7⓪(TST D0⓪(SNE D0⓪(ANDI #1,D0⓪(MOVE.W D0,(A3)+⓪$END⓪"END Bconstat;⓪"(*$L=*)⓪ ⓪ PROCEDURE clrscr;⓪"BEGIN⓪$Bconout (33C); Bconout ('E');⓪"END clrscr;⓪ ⓪ PROCEDURE curon;⓪"BEGIN⓪$Bconout (33C); Bconout ('e');⓪"END curon;⓪ ⓪ PROCEDURE curoff;⓪"BEGIN⓪$Bconout (15C); Bconout (33C); Bconout ('f');⓪"END curoff;⓪ ⓪ PROCEDURE bing;⓪"BEGIN⓪$Bconout (7C);⓪"END bing;⓪ ⓪ ⓪ PROCEDURE alert ( REF s1,s2,s3: ARRAY OF CHAR );⓪"VAR msg: ARRAY [0..269] OF CHAR;⓪"BEGIN⓪$Assign (s1, msg, voidO);⓪$WrapAlert (msg, 0);⓪$IF s2[0] # 0C THEN⓪&Append ('|', msg, strVal);⓪&Append (s2, msg, voidO);⓪&WrapAlert (msg, 0);⓪$END;⓪$Insert ('[0][',0,msg,strVal);⓪$Append ('][]',msg,strVal);⓪$Insert (s3,CARDINAL(Length(msg)-1),msg, voidO);⓪$FormAlert (1, msg,buttonNum);⓪"END alert;⓪"⓪ PROCEDURE load;⓪"VAR r : LoaderResults;⓪*msg : ARRAY [0..79] OF CHAR;⓪*name : FileStr;⓪"BEGIN⓪$IF Empty (currFn) THEN name := CodeName ELSE name := currFn END;⓪$TellLoading (newTellValue, name);⓪$LoadModule (name, StdPaths, name, msg, r);⓪$IF r # noError THEN alert (conc (name, NoLoadStr^), msg, OkStr^) END;⓪"END load;⓪ ⓪ PROCEDURE unload;⓪"VAR r : LoaderResults;⓪*name : FileStr;⓪"BEGIN⓪$IF Empty (currFn) THEN name := CodeName ELSE name := currFn END;⓪$UnLoadModule (name, r);⓪$IF r # noError THEN alert (conc (name, NoUnloadStr^), '', OkStr^) END;⓪"END unload;⓪ ⓪ PROCEDURE closeAllWindows;⓪"VAR w: CARDINAL;⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$LOOP⓪&w:= AESWindows.TopWindow ();⓪&IF w = 0 THEN EXIT END;⓪&AESWindows.CloseWindow (w);⓪&AESWindows.DeleteWindow (w);⓪$END;⓪$IF (GEMEnv.GEMVersion() >= $140) THEN⓪&AESWindows.ResetWindows ();⓪$ELSE⓪&AESUpdateWindow (FALSE);⓪$END;⓪"END closeAllWindows;⓪ ⓪ PROCEDURE call ( VAR modname: ARRAY OF CHAR; args: ARRAY OF CHAR;⓪1stackSize: LONGCARD; interactive, checkError, tool:BOOLEAN );⓪ ⓪"TYPE SufSet = SET OF MySuf;⓪"⓪"VAR sufstr : ARRAY[0..2] OF CHAR;⓪&dummy : ARRAY[0..12] OF CHAR;⓪&name, path,⓪&oldPath : PathStr;⓪&getparm : BOOLEAN;⓪&prgType : AESMisc.ProgramType;⓪&sufcnt, suffix : MySuf;⓪&res : INTEGER;⓪&dummyChar : CHAR;⓪&hdl : ADDRESS;⓪&prevStackSize : LONGCARD;⓪ ⓪"BEGIN⓪$Assign (modname, name, voidO);⓪$Upper (name);⓪ ⓪$SplitPath (name, path, dummy);⓪$SplitName (dummy,dummy,sufstr);⓪$suffix:= mod;⓪$IF sufstr[0] = 0C THEN⓪&ConcatName (name, suf[mod], name)⓪$ELSE⓪&FOR sufcnt:= MIN (MySuf) TO MAX (MySuf) DO⓪(IF StrEqual (sufstr,suf[sufcnt]) THEN⓪*suffix := sufcnt;⓪(END⓪&END;⓪$END;⓪$prgType:= AESMisc.graphicPrgm;⓪$getparm:= FALSE;⓪$IF suffix IN SufSet {ttp,mtp} THEN getparm:= interactive END;⓪$IF suffix IN SufSet {ttp,mtp,tos,mos} THEN prgType:= AESMisc.textPrgm END;⓪ ⓪$IF getparm THEN⓪&RequestArg (args);⓪$END;⓪ ⓪$GetDefaultPath (oldPath);⓪$IF ~noDirChange THEN⓪&IF (path[0] = 0C) AND NOT tool THEN⓪((* Ist kein Pfad angegeben, bleibt bei Tools und⓪)* Systemprgs der akt. Pfad erhalten⓪)*)⓪(SearchFile (name, StdPaths, fromStart, voidO, name);⓪(SplitPath (name, path, dummy);⓪&END;⓪&ReplaceHome (path);⓪&SetDefaultPath (path, voidI)⓪$END;⓪$⓪$(*$? UseExtKeys: IF NOT tool THEN DeInstallKbdEvents END; *)⓪$⓪$IF NOT multiGEM & NOT multiTOS THEN⓪&closeAllWindows; (* alle noch offenen Fenster (von ACCs) schließen *)⓪$END;⓪$⓪$IF prgType = AESMisc.textPrgm THEN⓪&HideMouse;⓪&clrscr;⓪&curon;⓪$END;⓪$⓪$IF DoShellWrite AND (GEMEnv.GEMVersion() >= $140) THEN⓪&IF ~multiTOS THEN⓪(AESMisc.ShellWrite (TRUE, prgType, name, args);⓪&END⓪$END;⓪ ⓪$IF NOT multiGEM & NOT multiTOS THEN⓪&(* AC_CLOSE-Nachricht an alle Accessories schicken *)⓪&appl_exit; (* nach appl_exit kein AES-Aufruf mehr! *)⓪$END;⓪$⓪$(* ---------------------- Programmstart ------------------------ *)⓪$prevStackSize:= DefaultStackSize;⓪$IF stackSize # 0 THEN DefaultStackSize:= stackSize END;⓪$CallModule (name, StdPaths, args, NIL, exitCode, callMsg, callRes);⓪$DefaultStackSize:= prevStackSize;⓪$(* ---------------------- Programmende ------------------------- *)⓪$⓪$IF NOT multiGEM & NOT multiTOS THEN⓪&(* beim GEM wieder anmelden *)⓪&appl_init; (* erst jetzt wieder AES-Aufrufe erlaubt! *)⓪$END;⓪ ⓪$IF DoShellWrite AND (GEMEnv.GEMVersion() >= $140) THEN⓪&(* Dies alles funktioniert erst ab TOS 1.4 richtig *)⓪&IF ~multiTOS THEN⓪(AESMisc.ShellWrite (FALSE, AESMisc.graphicPrgm, ShellName, '');⓪&END⓪$END;⓪$⓪$IF prgType = AESMisc.textPrgm THEN⓪&(* Nach Programmende bei TOS-Programmen auf Tastendruck warten *)⓪&IF interactive & shellParm.waitOnReturn⓪)& NOT ScanMode & (callRes = noError) THEN⓪(WHILE Bconstat () DO dummyChar:= Bconin () END;⓪(curon;⓪(dummyChar:= Bconin ()⓪&END;⓪&curoff;⓪&ShowMouse⓪$END;⓪ ⓪$GEMEnv.MouseInput (TRUE); (* ...falls Programm die Maus abgeschaltet hat *)⓪$ShowArrow;⓪ ⓪$IF NOT multiGEM & NOT multiTOS THEN⓪&closeAllWindows; (* alle noch offenen Fenster (von ACCs) schließen *)⓪$END;⓪ ⓪$ClearDeskAndShowMsg;⓪$⓪$AESUpdateWindow (TRUE);⓪ ⓪$IF Inconsistent () THEN⓪&alert (memErrorAlt, '', OkStr^)⓪$END;⓪ ⓪$(*$? UseExtKeys: IF NOT tool THEN InstallKbdEvents END; *)⓪ ⓪$SetDefaultPath (oldPath, res);⓪ ⓪$IF checkError THEN⓪&IF callRes # noError THEN⓪(IF callRes = exitFault THEN⓪*alert (callMsg, '', OkStr^)⓪(ELSE⓪*alert (conc (name, NoExecStr^), callMsg, OkStr^)⓪(END⓪&ELSIF ScanMode THEN⓪(PrepareScan;⓪(IF ScanBox (TextName) THEN⓪*autoCmd := scan⓪(ELSE⓪*autoCmd := noCmd⓪(END⓪&ELSIF exitCode # 0 THEN⓪(CASE exitCode OF⓪*fFileNotFound,⓪*fPathNotFound,⓪*fInvalidDrive: FormError (2)|⓪4(* "Diese Anwendung kann Datei oder Ordner nicht finden" *)⓪*fAccessDenied: FormError (5)|⓪6(* "Datei existiert bereits oder ist Schreibgeschützt" *)⓪*fTooManyOpen,⓪*fInsufficientMemory: FormError (8)|⓪-(* "Es steht nicht genug Speicher für diese Anw. zur Verfügung" *)⓪(ELSE⓪*alert (conc (RetStr^, IntToStr (exitCode, 0)), '', OkStr^)⓪(END⓪&END⓪$END;⓪$ScanMode := FALSE;⓪ ⓪$AESUpdateWindow (FALSE);⓪ ⓪"END call;⓪ ⓪ ⓪ PROCEDURE callEdit (VAR s0: ARRAY OF CHAR; errMsg: BOOLEAN);⓪ ⓪"VAR s, voidStr,⓪&tempPath : ARRAY [0..126] OF CHAR;⓪&f : File;⓪&lastBreak : BOOLEAN;⓪&zero : CARDINAL;⓪ ⓪"PROCEDURE writeTempFile;⓪ ⓪$PROCEDURE stateError (): BOOLEAN;⓪ ⓪&BEGIN⓪(IF State (f) # fOK THEN⓪*FileAlert (State (f));⓪*ResetState (f);⓪*Remove (f);⓪*RETURN TRUE⓪(ELSE RETURN FALSE END;⓪&END stateError;⓪$⓪$PROCEDURE writeLn (VAR str: ARRAY OF CHAR): BOOLEAN;⓪$⓪&BEGIN⓪(Text.WriteString (f, str);⓪(IF stateError () THEN RETURN FALSE END;⓪(Text.WriteLn (f);⓪(IF stateError () THEN RETURN FALSE END;⓪(RETURN TRUE⓪&END writeLn;⓪$⓪$VAR s2: Str128;⓪&⓪$BEGIN⓪&ReplaceHome (tempPath);⓪&Create (f, tempPath, writeSeqTxt, replaceOld);⓪&IF stateError () THEN RETURN END;⓪&IF ~ EditorParm.passName THEN⓪(IF ~ writeLn (TextName) THEN RETURN END;⓪&END;⓪&IF ~ EditorParm.passErrorPos AND errMsg THEN⓪(Assign (CardToStr (TextLine, 0), s2, voidO);⓪(Append (' ', s2, voidO);⓪(Append (CardToStr (TextCol - 1, 0), s2, voidO);⓪(IF ~ writeLn (s2) THEN RETURN END;⓪&END;⓪&IF ~ EditorParm.passErrorText AND errMsg THEN⓪(IF ~ writeLn (ErrorMsg) THEN RETURN END;⓪&END;⓪&Close (f);⓪$END writeTempFile;⓪ ⓪"BEGIN⓪$Split (s0, PosLen (' ', s0, 0), TextName, s, voidO);⓪$IF EditorParm.searchSources THEN⓪&SearchFile (TextName, SrcPaths, fromStart, voidO, TextName)⓪$END;⓪$IF EditorParm.passName THEN Insert (TextName, 0, s, voidO) END;⓪ ⓪$(* Zeiger auf akt. Dateinamen dem Editor mit übergeben⓪&IF isToolbox THEN⓪(Append (' ^', s, voidO);⓪(Append (CardToStr (LONGCARD (ADR (TextName)), 0), s, voidO);⓪(Append (' ', s, voidO);⓪&END;⓪$*)⓪ ⓪$IF EditorParm.tempShellFile THEN⓪&SplitPath (EditorParm.name, tempPath, voidStr);⓪&Append (EditorParm.tempShellName, tempPath, voidO);⓪&Append (tempPath, s, strVal);⓪&writeTempFile;⓪$END;⓪$⓪$IF ~ EditorParm.passArgument THEN s := '' END;⓪$⓪$lastBreak:= shellParm.breakActive;⓪$shellParm.breakActive:= FALSE;⓪$call (EditorParm.name, s, EditorStackSize, FALSE, FALSE, TRUE);⓪$shellParm.breakActive:= lastBreak;⓪$⓪$IF EditorParm.tempEditorFile THEN⓪&SplitPath (EditorParm.name, tempPath, voidStr);⓪&Append (EditorParm.tempEditorName, tempPath, voidO);⓪&ReplaceHome (tempPath);⓪&Open (f, tempPath, readSeqTxt);⓪&IF State (f) = fOK THEN⓪(Text.ReadString (f, s);⓪(Close (f);⓪(zero := 0;⓪(exitCode := StrToCard (s, zero, strVal);⓪(IF ~ strVal THEN exitCode := 0 END;⓪&ELSE⓪(exitCode:= 0⓪&END;⓪$END;⓪$⓪$autoCmd := noCmd;⓪$IF callRes # noError THEN⓪&alert (EdStr^, callMsg, OkStr^)⓪$ELSE⓪&CASE exitCode OF⓪(1: autoCmd := compile|⓪(2: autoCmd := exec_src|⓪(3: autoCmd := dftMake|⓪(4: autoCmd := dftMake_exec|⓪&ELSE⓪&END;⓪&IF (autoCmd = dftMake_exec) OR (autoCmd = dftMake) THEN⓪(IF NOT makeActive THEN⓪*editorsMakeCmd:= autoCmd;⓪*makeActive:= TRUE;⓪(END;⓪(autoCmd:= contMake⓪&ELSE⓪(IF makeActive THEN⓪*FormAlert (1, ContMakeAlt^, buttonNum);⓪*IF buttonNum = 1 THEN⓪,autoCmd:= contMake⓪*END⓪(END⓪&END⓪$END;⓪"END callEdit;⓪ ⓪ PROCEDURE hdedit (wrk: BOOLEAN);⓪ ⓪"VAR name1, name2: NameStr;⓪&dummy : Str128;⓪"⓪"BEGIN⓪$IF wrk THEN⓪&callEdit (workFName, FALSE);⓪$ELSE⓪&callEdit (currFn, FALSE)⓪$END;⓪$Upper (TextName);⓪$SplitPath (TextName, dummy, name1);⓪$SplitPath (workFName, dummy, name2);⓪$IF NOT StrEqual (name1, name2) THEN lastFn := TextName END;⓪"END hdedit;⓪ ⓪ PROCEDURE hdrun (wrk, tool: BOOLEAN);⓪ ⓪"VAR found,⓪(codeOK : BOOLEAN;⓪(f : File;⓪(cDate,⓪(sDate : Clock.Date;⓪(cTime,⓪(sTime : Clock.Time;⓪(sname,⓪(cname,⓪(voidStr,⓪(suffix : FileStr;⓪ ⓪ ⓪"PROCEDURE longTime (d:Clock.Date; t:Clock.Time): LONGCARD;⓪$BEGIN⓪&RETURN LONG (Clock.PackDate (d)) * $10000 + LONG (Clock.PackTime (t))⓪$END longTime;⓪ ⓪"PROCEDURE getCodeDateTime ( suffix: MySuf;⓪Apaths : PathList;⓪=VAR cname : FileStr;⓪=VAR found : BOOLEAN);⓪$VAR testName: FileStr;⓪(testN2: FileStr;⓪(path: ptrString;⓪$BEGIN⓪&found:= FALSE;⓪ ⓪&ConcatName (cname, suf[suffix], testN2);⓪&IF NOT Empty (MainOutputPath) THEN⓪((* Eingestellten Ausgabe-Pfad prüfen *)⓪(Concat (MainOutputPath, testN2, testName, voidO);⓪&ELSE⓪((* Ausgabe-Pfad aus Compiler-Pfaden prüfen *)⓪(IF suffix = imp THEN⓪*Concat (ImpOutPath, testN2, testName, voidO);⓪(ELSE⓪*Concat (ModOutPath, testN2, testName, voidO);⓪(END⓪&END;⓪&ReplaceHome (testName);⓪&Open (f, testName, readOnly);⓪&found:= (State (f) >= fOK);⓪&IF NOT found THEN⓪((* Datei auf Default-Pfaden suchen *)⓪(SearchFile (testN2, paths, fromStart, found, testName);⓪(IF found THEN⓪*Open (f, testName, readOnly);⓪(END⓪&END;⓪&IF found THEN⓪(GetDateTime (f, cDate, cTime);⓪(Close (f);⓪(cname:= testName;⓪&END;⓪$END getCodeDateTime;⓪ ⓪"BEGIN (* hdrun *)⓪$codeOK := FALSE;⓪$(* check, wether code is valid if source is executed *)⓪$IF wrk THEN⓪&SearchFile (workFName, SrcPaths, fromStart, found, sname);⓪$ELSIF IsSourceName (currFn) THEN⓪&SearchFile (currFn, SrcPaths, fromStart, found, sname)⓪$ELSE⓪&(* wir haben einen Code -> sofort ausführen *)⓪&codeOK := TRUE⓪$END;⓪$IF NOT codeOK THEN⓪&IF found THEN⓪((* Source vorhanden *)⓪(IF wrk THEN⓪*workFName:= sname; cname:= workCName⓪(ELSE⓪*currFn:= sname; cname:= ''⓪(END;⓪(IF Empty (cname) THEN⓪*(* Wir müssen den Code suchen *)⓪*SplitPath (sname, voidStr, cname);⓪*SplitName (cname, cname, suffix);⓪*getCodeDateTime (mod, ModPaths, cname, codeOK);⓪*IF NOT codeOK THEN⓪,getCodeDateTime (mos, ModPaths, cname, codeOK) END;⓪*IF NOT codeOK THEN⓪,getCodeDateTime (mtp, ModPaths, cname, codeOK) END;⓪*IF NOT codeOK THEN⓪,getCodeDateTime (imp, ImpPaths, cname, codeOK) END;⓪(ELSE⓪*(* Code schon vorhanden *)⓪*Open (f, cname, readOnly);⓪*codeOK:= (State (f) = fOK);⓪*IF codeOK THEN⓪,GetDateTime (f, cDate, cTime);⓪,Close (f);⓪*END;⓪(END;⓪(IF codeOK THEN⓪*(* Code vorhanden -> Zeit der Source ermitteln und mit Code vergl. *)⓪*Open (f, sname, readOnly);⓪*GetDateTime (f, sDate, sTime);⓪*Close (f);⓪*codeOK:= longTime (cDate,cTime) >= longTime (sDate,sTime);⓪(END;⓪&ELSE⓪((* Source nicht vorhanden -> Fehler melden? *)⓪((* wenn nicht, wird einfach Compiler gestartet... (weil codeOK=FALSE) *)⓪&END;⓪$ELSE⓪&cname:= currFn⓪$END;⓪$IF codeOK THEN⓪&IF wrk THEN workCName := cname⓪&ELSE CodeName := cname END;⓪&call (cname, args, 0, TRUE, TRUE, tool)⓪$ELSE⓪&IF wrk THEN workCName:= '' END;⓪&TextName := sname;⓪&autoCmd := comp_exec⓪$END⓪"END hdrun;⓪ ⓪ ⓪ PROCEDURE DoEditBox (batch, mustShow: BOOLEAN; VAR cont: BOOLEAN);⓪"VAR s: String;⓪&msg: Str128;⓪&buttonNum: CARDINAL;⓪"BEGIN⓪$(* Signalton: *)⓪$bing;⓪$IF mustShow OR EditorParm.waitOnError THEN⓪&msg := '[2][][]';⓪&IF batch THEN⓪(Insert (EditBatStr^, 6, msg, voidO)⓪&ELSE⓪(Insert (EditStr^, 6, msg, voidO)⓪&END;⓪&s:= ErrorMsg;⓪&WrapAlert (s, 0);⓪&Insert (s, 4, msg, voidO);⓪&FormAlert (1, msg, buttonNum);⓪&IF buttonNum = 1 THEN⓪(autoCmd:= edit; cont:= FALSE;⓪&ELSE⓪(autoCmd:= noCmd; cont:= (buttonNum = 2);⓪&END⓪$ELSE⓪&autoCmd:= edit; cont:= FALSE;⓪$END⓪"END DoEditBox;⓪ ⓪ ⓪ (* callComp -- Calls the compiler to compile the file 'modName'.⓪!* 'work = TRUE' means the workfile is compiled.⓪!* 'batch = TRUE' means the compiler is called while⓪!* executing a batch file. In that case 'cont' states,⓪!* if the execution of the batch file has to continue⓪!* after this proc. returns.⓪!*)⓪ ⓪ PROCEDURE callComp (VAR modname: ARRAY OF CHAR;⓪8work,⓪8batch : BOOLEAN;⓪4VAR cont : BOOLEAN);⓪ ⓪"VAR i:INTEGER;⓪&s,msg:Str128;⓪ ⓪"BEGIN⓪$(* String mit Compileroptionen aufbauen.⓪%*)⓪$WITH CompilerParm DO⓪&IF shortMsgs THEN s:= ' -Q' ELSE s:= ' +Q' END;⓪&Append (' ', s, voidO);⓪&Append (CompilerArgs, s, voidO);⓪&IF ~ Empty (MainOutputPath) THEN⓪(Append (' /O', s, voidO);⓪(Append (MainOutputPath, s, voidO);⓪&END;⓪&IF protocol THEN⓪(Append (' /C', s, voidO);⓪(Append (CardToStr (protWidth, 0), s, voidO);⓪(Append (' /P', s, voidO);⓪(Append (protName, s, voidO);⓪&END;⓪$END;⓪$⓪$CodeName:= '';⓪$IF autoCmd = scan THEN ScanMode:= TRUE END;⓪$call (CompilerParm.name, conc (modname, s),⓪*CompilerStackSize, FALSE, FALSE, TRUE);⓪$⓪$cont:= TRUE;⓪$IF callRes # noError THEN⓪&alert (CompStr^, callMsg, OkStr^);⓪&autoCmd:= noCmd⓪$ELSE⓪&CASE exitCode OF⓪(0: IF autoCmd = scan THEN⓪/autoCmd:= edit⓪-ELSIF ~ batch THEN⓪-⓪/IF makeActive THEN⓪1CodeName:= LastCodeName;⓪/ELSE⓪1Upper (CodeName);⓪1LastCodeName:= CodeName;⓪1LastCodeSize:= CodeSize;⓪/END;⓪/IF work THEN⓪1workCName:= CodeName;⓪1writeWorkName (TextName, CodeName);⓪/END;⓪/IF autoCmd = comp_exec THEN⓪1autoCmd:= execute⓪/ELSE⓪1autoCmd:= noCmd⓪/END;⓪/⓪-END|⓪(2: DoEditBox (batch, TRUE, cont)|⓪(3: DoEditBox (batch, FALSE, cont)⓪&ELSE⓪(autoCmd:= noCmd⓪&END⓪$END⓪"END callComp;⓪ ⓪ ⓪ PROCEDURE callLink (VAR moduleName: ARRAY OF CHAR);⓪ ⓪"VAR s: ARRAY [0..124] OF CHAR;⓪"⓪"BEGIN⓪$Assign (moduleName, s, voidO);⓪$WITH LinkerParm DO⓪&IF optimize = partOptimize THEN⓪(Append (' -H', s, voidO);⓪&ELSIF optimize = nameOptimize THEN⓪(Append (' -M', s, voidO);⓪&ELSIF optimize = fullOptimize THEN⓪(Append (' -F', s, voidO);⓪&END;⓪&IF fastLoad THEN⓪(Append (' -0', s, voidO)⓪&END;⓪&IF fastCode THEN⓪(Append (' -1', s, voidO)⓪&END;⓪&IF fastMemory THEN⓪(Append (' -2', s, voidO)⓪&END;⓪&IF symbolFile THEN⓪(Append (' -S', s, voidO);⓪(Append (symbolArgs, s, voidO)⓪&END;⓪&IF outputName[0] # '' THEN⓪(Append (' -O', s, voidO);⓪(Append (outputName, s, voidO)⓪&END;⓪&call (name, s, LinkerStackSize, FALSE, FALSE, TRUE);⓪$END;⓪$IF callRes # noError THEN⓪&alert (LinkStr^, callMsg, OkStr^)⓪$END⓪"END callLink;⓪ ⓪ ⓪ PROCEDURE callMake (REF name: ARRAY OF CHAR; batch: BOOLEAN; VAR cont: BOOLEAN);⓪ ⓪"BEGIN⓪$call (shellParm.makeName, name, MakeStackSize, FALSE, FALSE, TRUE);⓪$cont:= TRUE;⓪$IF callRes # noError THEN⓪&alert (MakeStr^, callMsg, OkStr^);⓪&autoCmd:= noCmd;⓪$ELSE⓪&CASE exitCode OF⓪(0: LastCodeName:= CodeName;⓪+LastCodeSize:= 0L;⓪+ConcatPath (TemporaryPath, MakeCompFileName, TextName);⓪+ReplaceHome (TextName);⓪+IF autoCmd = make_exec THEN autoCmd:= comp_exec⓪+ELSE autoCmd:= compile END|⓪(1: IF autoCmd = make_exec THEN autoCmd:= execute⓪+ELSE autoCmd:= noCmd END|⓪(2: DoEditBox (batch, FALSE, cont)⓪&ELSE⓪(autoCmd:= noCmd;⓪&END;⓪$END⓪"END callMake;⓪ ⓪ ⓪ PROCEDURE hdscan (wrk: BOOLEAN);⓪ ⓪"BEGIN⓪$ErrorMsg:= '<Scanned>';⓪$autoCmd:= scan;⓪$IF wrk THEN callComp (workFName, TRUE, FALSE, voidO);⓪$ELSIF Empty (currFn) THEN callComp (lastFn, FALSE, FALSE, voidO)⓪$ELSE callComp (currFn, FALSE, FALSE, voidO) END;⓪"END hdscan;⓪ ⓪ PROCEDURE hdcomp (wrk: BOOLEAN);⓪ ⓪"BEGIN⓪$IF wrk THEN callComp (workFName, TRUE, FALSE, voidO);⓪$ELSE callComp (currFn, FALSE, FALSE, voidO); lastFn:= currFn; END;⓪"END hdcomp;⓪ ⓪ PROCEDURE hdlink (wrk: BOOLEAN);⓪ ⓪"BEGIN⓪$IF wrk THEN callLink (workCName)⓪$ELSE callLink (currFn) END;⓪"END hdlink;⓪"⓪ PROCEDURE hdmake (wrk: BOOLEAN);⓪ ⓪"BEGIN⓪$IF wrk THEN callMake (workFName, FALSE, voidO)⓪$ELSE callMake (currFn, FALSE, voidO) END;⓪"END hdmake;⓪ ⓪ PROCEDURE action (what: actionType; wrkFile, tool: BOOLEAN);⓪ ⓪"TYPE aTypeSet = SET OF actionType;⓪"⓪"CONST noHideAction = aTypeSet {doLoad, doUnLd, doCont};⓪"⓪"VAR s : Str128;⓪&dummy, i: CARDINAL;⓪&n1, n2 : ARRAY [0..11] OF CHAR;⓪&hidden : BOOLEAN;⓪ ⓪"BEGIN⓪$IF wrkFile THEN readWorkNames END;⓪$⓪$IF what IN noHideAction THEN hidden:= FALSE⓪$ELSE HideSS (TRUE); hidden:= TRUE END;⓪$⓪$editorsMakeCmd:= noCmd;⓪$makeActive:= FALSE;⓪$CASE what OF⓪&doEdit: hdedit (wrkFile)|⓪&doComp: hdcomp (wrkFile)|⓪&doExec: hdrun (wrkFile, tool);⓪.IF wrkFile THEN writeWorkName (workFName, workCName) END|⓪&doLink: hdlink (wrkFile)|⓪&doScan: hdscan (wrkFile)|⓪&doCpEx: autoCmd := comp_exec; hdcomp (wrkFile)|⓪&doLoad: load|⓪&doUnLd: unload|⓪&doCont: InputScan (ErrorMsg, ScanIndex);⓪.PrepareScan;⓪.IF ScanBox (TextName) THEN⓪0HideSS (TRUE); hidden:= TRUE;⓪0autoCmd:= scan;⓪0callComp (TextName, FALSE, FALSE, voidO)⓪.END|⓪&doBtch: IF wrkFile THEN ExecuteBatch (workFName, TRUE)⓪.ELSE ExecuteBatch (currFn, TRUE) END|⓪&doParm: IF wrkFile THEN LoadParameter (workFName)⓪.ELSE LoadParameter (currFn) END|⓪&doMake,⓪&doMkEx,⓪&doDftM: makeActive:= TRUE;⓪.autoCmd:= contMake⓪$ELSE⓪$END;⓪ ⓪$REPEAT⓪&CASE autoCmd OF⓪ ⓪(contMake: CASE what OF⓪5doMake: autoCmd:= noCmd; hdmake (wrkFile)|⓪5doMkEx: autoCmd:= make_exec; hdmake (wrkFile)|⓪5doDftM: autoCmd:= dftMake⓪3ELSE⓪5autoCmd:= editorsMakeCmd⓪3END|⓪ ⓪(edit : Concat (TextName, ' ', s, strVal);⓪3IF EditorParm.passErrorPos THEN⓪5Append (CardToStr (TextLine, 0), s, strVal);⓪5Append (' ', s, strVal);⓪5Append (CardToStr (TextCol - 1, 0), s, strVal);⓪5Append (' ', s, strVal);⓪3END;⓪3IF EditorParm.passErrorText THEN⓪5Append ('"', s, strVal);⓪5Append (ErrorMsg, s, voidO);⓪5Append ('" ', s, strVal);⓪3END;⓪3callEdit (s, TRUE)|⓪ ⓪(scan,⓪(compile,⓪(comp_exec: callComp (TextName, wrkFile, FALSE, voidO)|⓪(⓪(exec_src : autoCmd:= noCmd;⓪3workFName:= '';⓪3workCName:= '';⓪3wrkFile:= FALSE;⓪3WITH WorkField DO⓪5IF current >= 0 THEN⓪7i:= 0;⓪7LOOP (* workFile richtig bestimmen *)⓪9WITH elems[i] DO⓪;IF used & StrEqual (TextName, sourceName) THEN⓪=workFName:= sourceName;⓪=workCName:= codeName;⓪=wrkFile:= TRUE;⓪=EXIT⓪;END;⓪9END;⓪9INC (i);⓪9IF i = maxWorkFiles THEN⓪;EXIT⓪9END;⓪7END⓪5END;⓪3END;⓪3IF ~wrkFile THEN currFn:= TextName END;⓪3hdrun (wrkFile, tool);⓪3IF wrkFile THEN writeWorkName (workFName, workCName) END|⓪ ⓪(execute : autoCmd:= noCmd;⓪3call (CodeName, args, 0, TRUE, TRUE, tool)|⓪ ⓪(dftMake_exec,⓪(dftMake : IF autoCmd = dftMake_exec THEN autoCmd:= make_exec END;⓪3callMake ('' (* >> Make verw. Default-Namen aus ShellMsg *), FALSE, voidO)|⓪&ELSE⓪&END⓪$UNTIL autoCmd = noCmd;⓪$⓪$Assign (lastFn, TextName, voidO);⓪$⓪$IF hidden THEN ShowSS (TRUE) END;⓪"END action;⓪ ⓪ ⓪ ⓪ TYPE pathEntry = RECORD⓪<used: BOOLEAN;⓪<path: PathStr;⓪:END;⓪ ⓪ VAR pathArray: ARRAY [1..MaxSearchPaths] OF pathEntry;⓪ ⓪ PROCEDURE ExecuteBatch (name: ARRAY OF CHAR; load: BOOLEAN);⓪ ⓪"VAR f : File;⓪&s, arg : ARRAY[0..255] OF CHAR;⓪&gotLine, cont,⓪&doIt : BOOLEAN;⓪&result : INTEGER;⓪&oldDrive : Drive;⓪&oldPath : PathStr;⓪"⓪"PROCEDURE delSpc (VAR s:ARRAY OF CHAR);⓪$BEGIN⓪&WHILE s[0] = ' ' DO Delete (s,0,1, voidO) END⓪$END delSpc;⓪"⓪"PROCEDURE equ (a,b: ARRAY OF CHAR): BOOLEAN;⓪$BEGIN⓪&Upper (a);⓪&Upper (b);⓪&RETURN Compare (FileName (a), FileName (b)) = equal⓪$END equ;⓪ ⓪"PROCEDURE setLinkName (VAR n:ARRAY OF CHAR);⓪$VAR first: CHAR;⓪(i: CARDINAL;⓪(useEmpty: BOOLEAN;⓪$BEGIN⓪&first:=n[0];⓪&IF (first = '-') OR (first = '+') THEN⓪(Delete (n, 0, 1, voidO);⓪(delSpc (n);⓪&END;⓪&FOR useEmpty:= FALSE TO TRUE DO⓪(FOR i:= MIN (LLRange) TO MAX (LLRange) DO⓪*IF equ (LinkerParm.linkList[i].name, n)⓪*OR (useEmpty AND Empty (LinkerParm.linkList[i].name)) THEN⓪,LinkerParm.linkList[i].valid:= (first # '-');⓪,Assign (n, LinkerParm.linkList[i].name, voidO);⓪,RETURN⓪*END⓪(END⓪&END⓪$END setLinkName;⓪"⓪"PROCEDURE setToolName (VAR n:ARRAY OF CHAR);⓪$VAR i: CARDINAL;⓪$BEGIN⓪&FOR i:=1 TO MaxTool DO⓪(IF ~ToolField[i].used THEN⓪*ToolField[i].used:= TRUE;⓪*Assign (n,ToolField[i].name, voidO);⓪*RETURN⓪(END⓪&END⓪$END setToolName;⓪"⓪"PROCEDURE getFirstPath (paths: PathList; VAR path: ARRAY OF CHAR);⓪$VAR entry: PathEntry;⓪$BEGIN⓪&Lists.ResetList (paths);⓪&entry:= Lists.NextEntry (paths);⓪&IF entry # NIL THEN⓪(Assign (entry^, path, voidO)⓪&ELSE⓪(path[0]:= ''⓪&END⓪$END getFirstPath;⓪"⓪"PROCEDURE killPaths (VAR paths: PathList);⓪"⓪$VAR entry: ADDRESS;⓪(idx : CARDINAL;⓪"⓪$BEGIN⓪&Lists.ResetList (paths);⓪&entry:= Lists.PrevEntry (paths);⓪&WHILE entry # NIL DO⓪(idx:= 1;⓪(WHILE (idx <= MaxSearchPaths)⓪.AND (ADR (pathArray[idx].path) # entry) DO INC (idx) END;⓪(IF idx <= MaxSearchPaths THEN pathArray[idx].used:= FALSE END;⓪(Lists.RemoveEntry (paths, voidO);⓪(entry:= Lists.CurrentEntry (paths);⓪&END;⓪$END killPaths;⓪"⓪"PROCEDURE setP ( VAR paths: PathList );⓪$VAR err:BOOLEAN; c:CHAR; idx: CARDINAL;⓪$BEGIN⓪&killPaths (paths);⓪&idx:= 1;⓪&LOOP⓪(IF EOF (f) THEN EXIT END;⓪(Text.ReadString (f,s);⓪(IF s[0] # ' ' THEN EXIT END;⓪(WHILE (idx <= MaxSearchPaths) AND pathArray[idx].used DO INC (idx) END;⓪(IF idx <= MaxSearchPaths THEN⓪*EatSpaces (s);⓪*IF Compare ('.',s) = equal THEN s:= '' END;⓪*ValidatePath (s);⓪*Assign (s,pathArray[idx].path,err);⓪*Lists.AppendEntry (paths,ADR(pathArray[idx].path),err);⓪*pathArray[idx].used:= TRUE;⓪*INC (idx)⓪(ELSE⓪*alert (NoPathsStr^, '', OkStr^)⓪(END⓪&END;⓪&gotLine:= TRUE;⓪$END setP;⓪"⓪"PROCEDURE is (REF s0:ARRAY OF CHAR): BOOLEAN;⓪$BEGIN⓪&RETURN StrEqual (s0,s)⓪$END is;⓪ ⓪"PROCEDURE prep (REF in: ARRAY OF CHAR): BOOLEAN;⓪$BEGIN⓪&Split (in,PosLen (' ',in,0),s,arg,strVal);⓪&delSpc (arg);⓪&Upper (s);⓪&RETURN (s[0] # 0C) AND (s[0] # '*')⓪$END prep;⓪ ⓪"PROCEDURE getLC (VAR l: LONGCARD);⓪$VAR i: CARDINAL;⓪$BEGIN⓪&i:= 0;⓪&l:= StrToLCard (arg, i, strVal);⓪$END getLC;⓪ ⓪"VAR found, tell: BOOLEAN;⓪&i: CARDINAL;⓪&res : INTEGER;⓪ ⓪"PROCEDURE unTell;⓪$BEGIN⓪&IF tell THEN⓪(TellLoading (endTell, '');⓪(tell:= FALSE⓪&END;⓪$END unTell;⓪ ⓪"BEGIN⓪$AESUpdateWindow (TRUE);⓪$ShowBee;⓪$tell:= FALSE;⓪$SearchFile (name, StdPaths, fromStart, found, name);⓪$Open (f, name, readSeqTxt);⓪$IF State (f) < 0 THEN⓪&GetStateMsg (State(f), s);⓪&alert (InfStr^, s, OkStr^);⓪$ELSE⓪&gotLine:= FALSE;⓪&cont:= TRUE;⓪&REPEAT⓪ ⓪(IF NOT gotLine THEN Text.ReadString (f, s) END;⓪(gotLine:= FALSE;⓪(⓪(doIt:= FALSE;⓪(IF prep (s) THEN⓪*IF is ('IF_SHELLSTART') THEN (* IF-Clause *)⓪,IF shellStart THEN⓪.doIt:= prep (arg);⓪,END;⓪*ELSIF is ('IF_EXITCODE') THEN⓪,i:= 0;⓪,IF StrToInt (arg, i, voidO) = exitCode THEN⓪.Copy (arg, i, 200, arg, voidO);⓪.doIt:= prep (arg);⓪,END⓪*ELSE⓪,doIt:= TRUE⓪*END;⓪(END;⓪ ⓪(IF doIt THEN⓪H(* misc *)⓪*IF is ('WAIT') THEN⓪,alert (arg,'',ContStr^);⓪*ELSIF is ('STACKSIZE') THEN⓪,getLC (DefaultStackSize);⓪,IF DefaultStackSize < 1024L THEN DefaultStackSize:= 1024 END;⓪ ⓪H(* tools *)⓪*ELSIF is ('DELETETOOLS') THEN⓪,FOR i:= 1 TO MaxTool DO ToolField[i].used:= FALSE END; (* Keine Tools *)⓪*ELSIF is ('TOOL') THEN⓪,setToolName (arg)⓪H(* loader commands *)⓪*ELSIF is ('EXEC') THEN⓪,Split (arg, PosLen (' ', arg, 0), arg, s, strVal);⓪,delSpc (s);⓪,unTell;⓪,ShowArrow;⓪,AESUpdateWindow (FALSE);⓪,Upper (arg);⓪,IF IsMBTFile (arg) THEN⓪.ExecuteBatch (arg, load)⓪,ELSE⓪.call (arg, s, 0, FALSE, TRUE, FALSE);⓪,END;⓪,AESUpdateWindow (TRUE);⓪,ShowBee;⓪,IF autoCmd # noCmd THEN cont:= FALSE END;⓪*ELSIF is ('POSTAMBLE1') THEN⓪,Split (arg,PosLen (' ',arg,0),postAmble1,postArgs1,strVal);⓪,delSpc (postArgs1);⓪,withPost1:= TRUE;⓪*ELSIF is ('POSTAMBLE2') THEN⓪,Split (arg,PosLen (' ',arg,0),postAmble2,postArgs2,strVal);⓪,delSpc (postArgs2);⓪,withPost2:= TRUE;⓪*ELSIF is ('LOAD') THEN⓪,IF load THEN⓪.IF NOT tell THEN⓪0TellLoading (initTell, ''); tell:= TRUE⓪.END;⓪.TellLoading (newTellValue, arg);⓪.LoadModule (arg, StdPaths, callMsg (* dummy *), callMsg,⓪:callRes);⓪,END⓪*ELSIF is ('UNLOAD') THEN⓪,IF load THEN⓪.UnLoadModule (arg, callRes)⓪,END⓪*⓪*ELSIF is ('LINKSTACKSIZE') THEN⓪,getLC (LinkerParm.linkStackSize);⓪*ELSIF is ('NO_OPTIMIZE') THEN⓪,LinkerParm.optimize:= noOptimize⓪*ELSIF is ('NAME_OPTIMIZE') THEN⓪,LinkerParm.optimize:= nameOptimize⓪*ELSIF is ('PART_OPTIMIZE') THEN⓪,LinkerParm.optimize:= partOptimize⓪*ELSIF is ('FULL_OPTIMIZE') THEN⓪,LinkerParm.optimize:= fullOptimize⓪*ELSIF is ('DRIVER') THEN⓪,setLinkName (arg)⓪*ELSIF is ('DELETEDRIVERS') THEN⓪,SysUtil0.ClearVar (LinkerParm.linkList);⓪ ⓪H(* comp./link/make *)⓪*ELSIF is ('COMPILE') THEN⓪,autoCmd:= noCmd;⓪,unTell;⓪,ShowArrow;⓪,AESUpdateWindow (FALSE);⓪,callComp (arg, FALSE, TRUE, cont);⓪,AESUpdateWindow (TRUE);⓪,ShowBee;⓪*ELSIF is ('MAKE') THEN⓪,autoCmd:= noCmd;⓪,unTell;⓪,ShowArrow;⓪,AESUpdateWindow (FALSE);⓪,callMake (arg, TRUE, cont);⓪,AESUpdateWindow (TRUE);⓪,ShowBee;⓪*ELSIF is ('LINK') THEN⓪,autoCmd:= noCmd;⓪,unTell;⓪,ShowArrow;⓪,AESUpdateWindow (FALSE);⓪,callLink (arg);⓪,AESUpdateWindow (TRUE);⓪,ShowBee;⓪*ELSIF is ('EDIT') THEN⓪,autoCmd:= noCmd;⓪,unTell;⓪,ShowArrow;⓪,AESUpdateWindow (FALSE);⓪,callEdit (arg, FALSE);⓪,AESUpdateWindow (TRUE);⓪,ShowBee;⓪H(* paths *)⓪*ELSIF is ('SETDIR') THEN⓪,SetCurrentDir (MOSGlobals.defaultDrv, arg, voidI);⓪*ELSIF is ('SETDRIVE') THEN⓪,SetDefaultDrive (StrToDrive (arg))⓪*ELSIF is ('SETPATH') THEN⓪,SetDefaultPath (arg, voidI)⓪ ⓪*ELSIF is ('DEFAULTPATH') THEN⓪,setP ( StdPaths );⓪*ELSIF is ('DEFPATH') THEN⓪,setP ( DefPaths );⓪,getFirstPath (DefPaths, DefOutPath);⓪*ELSIF is ('IMPPATH') THEN⓪,setP ( ImpPaths );⓪,getFirstPath (ImpPaths, ImpOutPath);⓪*ELSIF is ('MODPATH') THEN⓪,setP ( ModPaths );⓪,getFirstPath (ModPaths, ModOutPath);⓪*ELSIF is ('SOURCEPATH') THEN⓪,setP ( SrcPaths )⓪*ELSIF is ('DEFOUT') THEN⓪,Assign (arg, DefOutPath, voidO);⓪,ValidatePath (DefOutPath)⓪*ELSIF is ('IMPOUT') THEN⓪,Assign (arg, ImpOutPath, voidO);⓪,ValidatePath (ImpOutPath)⓪*ELSIF is ('MODOUT') THEN⓪,Assign (arg, ModOutPath, voidO);⓪,ValidatePath (ModOutPath)⓪*ELSIF is ('MAINOUTPUTPATH') THEN⓪,Assign (arg, MainOutputPath, voidO);⓪,ValidatePath (MainOutputPath);⓪*END;⓪(⓪(END;⓪(⓪&UNTIL EOF (f) OR NOT cont;⓪&Close (f);⓪ ⓪&(* getFirstPath-Aufrufe hier weg und oben eingefügt *)⓪ ⓪$END;⓪$unTell;⓪$⓪$ShowArrow;⓪$AESUpdateWindow (FALSE);⓪"END ExecuteBatch;⓪ ⓪ VAR level : CARDINAL;⓪ ⓪ PROCEDURE envlpProc (start, inChild:BOOLEAN; VAR i:INTEGER);⓪ ⓪"BEGIN⓪$IF ~inChild THEN⓪&IF start THEN⓪(IF level = 0 THEN⓪*IF shellParm.breakActive THEN voidO:=EnableBreak () END⓪(END;⓪(INC (level);⓪&ELSE⓪(DEC (level);⓪(IF level = 0 THEN⓪*IF shellParm.breakActive THEN DisableBreak END;⓪(END;⓪&END⓪$END;⓪"END envlpProc;⓪"⓪ ⓪ VAR err : BOOLEAN;⓪(wsp : MemArea;⓪(envlpHdl: EnvlpCarrier;⓪(ch : CHAR;⓪(idx : CARDINAL;⓪ ⓪ BEGIN (* Main of MShell *)⓪ ⓪"(* ShellMsg - Variablen initialisieren⓪#*)⓪"Active:= TRUE;⓪"⓪"(* Pfadlisten anlegen⓪#*)⓪"Lists.CreateList (StdPaths,err);⓪"Lists.CreateList (DefPaths,err);⓪"Lists.CreateList (ImpPaths,err);⓪"Lists.CreateList (ModPaths,err);⓪"Lists.CreateList (SrcPaths,err);⓪"FOR idx:= 1 TO MaxSearchPaths DO pathArray[idx].used:= FALSE END;⓪ ⓪"autoCmd:= noCmd;⓪"⓪"shellStart:= TRUE;⓪"⓪"IF InitSS () THEN⓪"⓪$(* Kontrolle gestarteter Prozesse zur Ctrl-C - Aktivierung⓪%*)⓪$SetEnvelope (envlpHdl, envlpProc, wsp);⓪$⓪$shellStart:= FALSE;⓪$(*$? UseExtKeys: InstallKbdEvents; *)⓪$TalkWithUser; (* Hauptschleife der Shell *)⓪$(*$? UseExtKeys: DeInstallKbdEvents; *)⓪ ⓪$IF withPost1 THEN⓪&call (postAmble1, postArgs1, 0L, FALSE, TRUE, FALSE);⓪$END;⓪$IF withPost2 THEN⓪&call (postAmble2, postArgs2, 0L, FALSE, TRUE, FALSE);⓪$END;⓪ ⓪$(* eigenen Namen löschen, damit GEMINI die Shell nicht nochmal startet *)⓪$IF DoShellWrite & (GEMEnv.GEMVersion () >= $140) THEN⓪&IF ~multiTOS THEN⓪(AESMisc.ShellWrite (FALSE, AESMisc.graphicPrgm, '', '');⓪&END⓪$END;⓪$⓪$ExitSS;⓪$⓪"ELSE⓪$TermProcess (fInsufficientMemory)⓪"END⓪"⓪ END MM2Shell.⓪ ə
- (* $FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$000001B9$FFE59909$0002F09F$FFE59909$0002E5B4$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909ü$0002E5AAT.......T.......T.......T.......T...............T....T..T.......T.......T.......$000229C6$000229EE$00022A36$00022A71$00022AEA$0002296C$00022949$00022966$000232F2$0002E5AA$00004BBA$000001B9$0001F739$0001F720$00022941$000229ABãÇé*)
-
